سليم حاصبيا

بدون معادلات تحدث مشكلة انه في كل مرة يجب ان تنسخ و تلصق البيانات اما الطريقة التي ارفقتها فإن البيانات تتحدّث اوتوماتيكباً في كل مرة تكتبين (او تعدلين) شيئاً في الشيت الاول يظهر مباشرة في الشيت الثاني (اكسل لا يسمح بالكتابة في الشيت الثاني مباشرة في المجال حيث موجودة المعادلات) لذا اذا اردت التعديل قي البيانات يتم ذلك من خلال الشيت الاول نموذج salim.xlsx

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

يرجى ارفاق الملف (أو جزء بسيط منه حوالي 20 صف او اي ملف نموذج) للعمل عليه عفواً لم الاحظ المشاركة الاولى

هذا مثال عما أقصده طالب salim2.xlsx

هذه الماكرو للزر الاول Option Explicit Sub Sheet1_2_3() Dim x x = Application.InputBox("Choose sheet from 1,2,3 to select", "Excel tel you", 1) Select Case x Case Is = 1 Sheets("1").Select Case Is = 2 Sheets("2").Select Case Is = 3 Sheets("3").Select Case Else MsgBox "you select Invalide number" End Select End Sub و هذه للزر الثّاني Sub Sheet_B_D() Dim x x = Application.InputBox("choose sheet from B,D to select", "Excel tel you", "B") x = UCase(x) Select Case x Case Is = "D" Sheets("D").Select Case Is = "B" Sheets("B").Select Case Else MsgBox "you select Invalide Name" End Select End Sub

ان استعمال (ROWS($A$1:$A1 يفيد قي موضوع بسيط وهو قي حال اضافة صف او حذف صف من الصفوف ( ليس اول صف من المعادلات)لا يحدث اخطاء حرب ان (تضيف صفاً او تحذف صفاً اينما تريد ما عدا الصف الأول) و سوف ترى النتيجة في الملف المرفق اما باقي المعادلات التي لا تستعمل هذه الصيغة (ROW(A1) مثلاُ فيحدث فيها احطاء في حال اضافة صف او حذف صف اما عملية 1 + (ROW($A$1 فهي حتى لا بيدأ Index من الرقم 0 طالب salim 1.xlsx

ربما يكون الحل طالب salim.xlsx

بالنسبة لملف pdf ليس لدي الخبرة الكافية لذلك تم تحميل ملف مشابه للأول لكن باستعمال الفلترة صفحة "Repport" بحث في كافة الشيتات الموجودة Salim.rar

حفظ الملف بصيغة xlsm

جرب هذا الملف الصفحة "Info" Seach_from_ sheets.rar

اذا كان هذا المثال ما تريد قم بتعديل المعادلات حسب ما تراه مناسباً Book1_salim.rar

في الخلية اكتب AT6 هذه المعادلة واسجب نزولاً =SUMPRODUCT(--($E6:$AR6="ح"))

ارفع ملف (مثال للمعاينة)

الملف الذي رفعته مضروب بفيروس وقد رفض الجهاز فتحه لذلك رفعت لك هذا الملف المشابه (زيادة في اثراء الموضوع استعملت الكود البرمجي) (يمكنك التعديل على الكود بما يتناسب مع المطلوب) Horizontally_date.rar

جرب هذا الملف تكرار بمعادلات SALIM.rar

جرب اعادة تحميل الملف من هنا Calander_without_Friday_1.rar

عندي لا وجود لهذا الخطأ

اذا اردت ملف اكثر تقدماً اليك هذا الملف Calander_without_Two_days.rar

ربما كان المطلوب Calander_without_Friday.rar

هذه المعادلة =SUM(INDEX($E$5:$P$5,MATCH($E$1,$E$4:$P$4,0)):$P$5) الملف مرفق دالة جمع لمجال محدد بشرط salim.rar

أخي رجب بعد السلام تم التعديل على المشاركة خاصتي يرجى الاطلاع و ابداء الرأي

هذه المعادلة من البداية حتى الشهر المذكور =SUM($E$5:OFFSET($E$1,4,MATCH($E$1,$E$4:$P$4,0)-1)) و هذه الاخرى من الشهر المذكور حتى النهاية =SUM($E$5:$P$5)-SUM($E$5:OFFSET($E$1,4,MATCH($E$1,$E$4:$P$4,0)-2))

ريما هذا ينفع Sheet Group.rar

ريما يكون المطلوب Loop Through Sheets.rar

يمكن استعمال هذا الكود(بدون حلقات تكرارية) ريما يكون اسرع Sub Salim_transfer() Dim ws As Worksheet, Sh As Worksheet Dim i As Long, LR As Long, LS As Long Dim New_LR As Long Dim My_Rg1 As Range Dim My_Rg2 As Range Application.ScreenUpdating = False Set ws = Sheets("مشتريات") Set Sh = Sheets("اضافه") LR = Sh.Range("C" & Rows.Count).End(xlUp).Row LS = ws.Range("C" & Rows.Count).End(xlUp).Row If LS <= 6 Then MsgBox "Nothing to Copy": GoTo Leave_Me_Out If LR < 2 Then LR = 2 Set My_Rg1 = ws.Range("a7:a" & LS) Set My_Rg2 = ws.Range("b7:e" & LS) With Sh.Range("b" & LR + 1).Resize(LS - 6, 1) .Value = ws.Range("E2").Value .Offset(, 1).Value = ws.Range("b4").Value .Offset(, 2).Value = ws.Range("b3").Value .Offset(, 3).Value = My_Rg1.Value .Offset(, 4).Resize(LS - 6, 4).Value = My_Rg2.Value End With New_LR = Sh.Range("B" & Rows.Count).End(xlUp).Row Sh.Range("a3:a5000").ClearContents For i = 1 To New_LR - 2 Sh.Range("a" & i + 2) = i Next Leave_Me_Out: Application.ScreenUpdating = True End Sub