عبدالفتاح في بي اكسيل

ما دمت تريدين جمع القيمتين لا تحتاجي الضغط على زر اي منهم مجرد تشغيل اليوزرفورم تظهر اجمالي القيمتين في الخلية المذكورة 😎

@Elsayeh اعتقد ان @lionheart قام باجابتك فهل يعقل بعد الاجابة تقوم بازالة علامة الاجابة وتطلب تعديل جديد .😱 كان من الاجدر ان تضع جميع متطلباتك من البداية والا فتح موضوع جديد. يجب ان تعلم اضافة متطلبات جديدة ستفقد حماس الاخرين لمساعدتك كما ان تصميم الكود ليس هين 😡 واعتقد ان @lionheart اعطاك كود قوي وسريع 😎

غير منطقي اجعل ملفاتك تعتمد على تحديث الملف الرئيسي

@فوزى فوزى لم تجيني على استفساري لا اجد اي مبرر لهذه الطريقة انت تصعب الامور على نفسك وعلينا . مع هذا هذه محاولة اذا لم يكن ما تريده عليك انتظار شخص اخر. index.xlsm

لماذا لا تجعل قائمة الملفات في عمود محدد ومن ثم عمل هايبر لينك وفتحها بدلا من كتابة الملفات يدويا في العمود الاول وربطها بعمود اخر. لا اعتقد انها طريقة عملية . اراها تاخذ الكثير من الوقت لتربط كل ملف تكتبه يدويا بعمود أخر .

لم تغير اي شي ولم تقرا بشكل جيد ما قلته لك واذ كنت تريد المساعدة ارفق ملف

حسب علمي مشكلة في تسمية الورقة ومن داخل محرر الاكواد ليس من داخل الورقة من خصائص الويندوز قم بتغيير اسم الشيت بالانجليزي وليس بالعربي الى sheet1 وان شاء الله يعمل

@مجاهد2013 افضل اجابة يتم اختيارها ل lionheart وليس ردك الاخير

ماكرو لتسمية الاوراق Option Explicit Sub renamesheets() Dim sheetsold() Dim sheetsnew() Dim lngSht As Long Dim ws As Worksheet 'الاسماء الجديدة sheetsnew = Array("selling1", "selling2") 'الاسماء القديمة sheetsold = Array("SH1", "SH3") On Error Resume Next For lngSht = LBound(sheetsold) To UBound(sheetsold) Set ws = Nothing Set ws = Sheets(sheetsold(lngSht)) If Not ws Is Nothing Then ws.Name = sheetsnew(lngSht) Next lngSht End sub

لماذا لا تضع اسماء في عمود محدد لشيت معينة اعتقد في المنتدى موجودة بكثرة يمكنك البحث عن الماكرو المناسب بدلا في كل مرة تريد تغيير الكود وهذا لن يكون متاحا دائما .

الملف النصي الذي اعرفه txt لا يوجد ملف نصي في ملفك . الى اي مدى واي ورقة واستبدال بيانات او نسخها الى الاسفل وهل الملف مغلق ام مفتوح . تحتاج تفاصيل كبيرة ودقيقة حتى يفهم الاعضاء ما تريد خصوصا ان موضوعك ليس سهل انجازه بالكود . لا اعتقد انا احد سيضيع وقته في مواضيع غامضة كهذه وانا واحد منهم .

@Hicham1470 الم تقرأ منشوري الاخير 😡

@Hicham1470 هذا الموضوع تم حله قم باصدار منشور جديد لتجد تفاعل اكثر من باقي الاعضاء 😉

@مريم2 التوقيع واضح اختي الكريمة ولا يحتاج للتاويل. للتوضيح فقط ليس كبرا مني لا اريد المساعدة ولكن لا اريد فتح المجال لعدة تعديلات يصبح الموضوع مشوش لبعض الاعضاء عند البحث عن موضوع معين مما يجعل المنشور كبير وممل كما انه يفقدني الحماسة في تقديم المساعدة . اعادة تصميم الكود او الصيغة من جديد ليس بالامر السهل خصوصا مثلي غير متخصص بالبرمجة عبارة عن هواية بالنسبة لي . ثقي تماما انت وغيرك من الاعضاء اذا احد طلب من تعديل ولم اجيبه اما لانه مضيعة للوقت او لا استطيع المساعدة لان هذا خارج امكانياتي . يمكن بقية الاعضاء يتساهلوا في عملية التعديل اما انا فلا بناء على ماسبق وعذرا على الاطالة . وهذه محاولة ان لم يكن ما تريده اعذريني وانتظري شخص اخر . هناك من اذكى مني واكثر احترافا في هذا المنتدى . تحياتي السؤال 5.xlsx

@a.kawkab هل من سبب انك لا تشير الى صاحب الجهد لهذا الكود الذي اخذته من هذا الموضوع المشابه وقمت بتعديل اسماء الشيتات https://www.officena.net/ib/topic/113326-تسمية-الملف-بإسم-الأسبوع-والسنة-تلقائيا-عند-الحفظ/ 🤔

@Elsayeh شكرا جزيلا على تفاعلك 😉 الرجاء اختيار افضل اجابة تراها ساعدتك في حل موضوعك حتى يتم قفل الموضوع من قبل ادرارة المنتدى . تحياتي .

اعتقد هذا سيفي بالغرض Sub DeleteRows() With Columns("B:G") .SpecialCells(xlBlanks).Delete Shift:=xlUp .Rows(5).Copy .SpecialCells(xlBlanks).PasteSpecial xlPasteFormats End With Application.CutCopyMode = False End Sub

لا اعتقد انك ستجد مساعدة مع كثرة الطلبات في موضوع واحد. لديك خيارين اما ان تبحث بالمنتدى وتقوم باخذ بعض الافكار من حلول سابقة شبيهة وتقوم بتعديلها بما يتناسب مع احتياجاتك او ان تقوم كل مرة بطرح سؤالك جزئية بشكل منفرد . 🙂

الم تقراي توقيعي قبل اضافة متطلبات جديدة ؟😱 هل من العدل بعد الاجابة تقوم باضافات جديدة ومتطلبات جديدة لم تكن موجود في سؤالك . يجدر بك اختيار اجابتي واقفال الموضوع وعدم اهدار وقت الاعضاء في كل مرة يدور في بالك فكرة تريدين تطبيقها .🙄 لماذا نقول دائما يجب وضع متطلباتك في الملف .

بصراحة هذا اخر محاولة وساخرج من هذا الموضوع تم اعطائه اكثر من حجمه Sub export_sheets() Dim Fname As String, ws As Worksheet Application.DisplayAlerts = False Sheets(Array("SH1", "SH3")).Copy For Each ws In ActiveWorkbook.Sheets ws.UsedRange = ws.UsedRange.Value Next ws ActiveWorkbook.SaveAs Filename:= _ "C:\Users\PC WORLD\Desktop\" & " report_ " & "W" & Format(Date, "WW") & "_" & Format(Date, "YYYY") & ".xlsx", FileFormat:=51 ActiveWorkbook.Close Application.DisplayAlerts = True End Sub

هذه محاولة واعتقد لديك خطا بالعد للموظف الثاني للسفر عد العناصر.xlsx

مالفائدة مما تطلبه ثم لم تدرج شكل البيانات كيف يجب ان تكون بعد تشغيل الكود المفترض.🙄

على حسب فهمي يجب تغيير العنوان واستبداله ب حدف الصفوف الفارغة جرب هذا الشي البسيط لاحظ اعتمدت على العمود c ما دام دائما فارغ كبقية الاعمدة فلم اشير الى بقية الاعمدة Sub DeleteRows() Intersect(Columns("c"), ActiveSheet.UsedRange).SpecialCells(xlBlanks).EntireRow.Delete End Sub

في هذا السطر If cll < 15 & cll > 0 Then يوجد خطا استبدل & ب and او or مثل هذا If cll < 15 and cll > 0 Then

ارى ان تقومي بوضع النتائج المتوقعة يدويا حتى يستطيع بقية الاعضاء مساعدتك 😎