حسونة حسين

السلام عليكم ورحمة الله وبركاته وبها نبدأ 

يمكنك استخدام الفلتر لتظهر لك السطور التى تريدها فقط ثم نسخ السطور المطلوبه الى شيت اخر

السلام عليكم ورحمة الله وبركاته

تقصد

30 يوم اصليه 

تكون 

٣٠ يوم اصليه

ولا

ثلاثون يوم اصليه

تفضل اخى الكريم 

example-1.xlsx

وعليكم السلام ورحمة الله وبركاته 

هذا الموضوع ان شاء الله موجود فيه طلبك  هنا

الملف بتاعك اخى الكربم ليس به بيانات علشان نقدر نساعدك 

رقم الحساب 

اسم البنك

اسم الفرع

مفروض لما تكتب رقم الحساب 

من اين ياتى بالبيانات ؟

الطبيعى ان يكون في صفحة اخرى تكتب فيها هذه البيانات ليتم جلبها عندما تكتب رقم الحساب

اسم البنك ورقم الحساب والفرع 

الداتا بتاعتهم هتكون فين

وعليكم السلام ورحمة الله وبركاته 

اخى عمر 

ارفق ملف لشكل النتائج المتوقعه

وجزاكم مثله اخى الكريم 

الحمد لله الذي بنعمته تتم الصالحات 

السلام عليكم ورحمة الله وبركاته 

واضح انك نسيت تحيه الاسلام يا اخى عمر

تفضل اخى الكريم 

Sub test()
    Dim WB As Workbook, WS As Worksheet, SH As Worksheet, LR As Long
    Set SH = ThisWorkbook.Worksheets("فاتورة")
    Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "القيمة_المضافة.xlsm", False)
    For Each WS In WB.Worksheets
        If SH.Range("J1") = WS.Name Then
            LR = Application.Max(5, WS.Cells(Rows.Count, 1).End(xlUp).Row) + 1
            WS.Range("A" & LR).Value = LR - 5
            WS.Range("B" & LR) = SH.Range("H27")
            WS.Range("C" & LR) = SH.Range("H23")
            WS.Range("D" & LR) = SH.Range("H25")
            WS.Range("E" & LR) = SH.Range("H26")
            WS.Range("F" & LR) = SH.Range("H3")
            WS.Range("G" & LR) = SH.Range("B7")
            WS.Range("H" & LR) = SH.Range("F5")
            WS.Range("H6:H" & LR).NumberFormat = "[$-1010000]yyyy/mm/dd;@"
            GoTo 86
        End If
    Next WS
86  WB.Close Savechanges:=True
End Sub

يرجي تعديل عنوان الموضوع لاسم مناسب للموضوع ليسهل في عمليه البحث للاعضاء

اخى الكريم عمر 

هذا طلب اخر غير الذي في المشاركه الاولى

اكتب موضوع جديد بالطلب الجديد 

على فكرة المنتدي مش هيدفعك فلوس على الموضوع الجديد 🤗😁

آمين يارب العالمين وإياكم 

وجزاكم مثله اخى الكريم 

وجزاكم مثله اخى الكريم 

وعليكم السلام ورحمه الله وبركاته

ارفق ملف اخى الكريم

واشرح به ما تريد بالصور

حتى يتسنى للاخوة المساعده وفهم المطلوب اكتر

وعليكم السلام ورحمه الله وبركاته

تفضل اخى الكريم

Sub Test()
Dim WB As Workbook, WS As Worksheet, SH As Worksheet, Arr As Variant, Temp As Variant
Dim i As Long, j As Long, p As Long
Set SH = ThisWorkbook.Worksheets("ترحيل يومية")
    Arr = SH.Range("A5:F" & SH.Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
    Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "العملاء.xlsm", False)
    For Each WS In WB.Worksheets
        If SH.Range("D2") = WS.Name Then
            For i = 1 To UBound(Arr, 1)
                p = p + 1
                For j = 1 To UBound(Arr, 2)
                    Temp(p, j) = Arr(i, j)
                Next
            Next
        End If
        If p > 0 Then
            WS.Range("H" & WS.Cells(Rows.Count, 8).End(xlUp).Row + 1).Resize(p, UBound(Temp, 2)).Value = Temp
            WS.Range("K7:K" & WS.Cells(Rows.Count, 8).End(xlUp).Row).NumberFormat = "[$-1010000]yyyy/mm/dd;@"
            GoTo 86
        End If
    Next WS
86 WB.Close Savechanges:=True

End Sub

تفضل اخى الكريم

1- اجعل الملف الذي اسمه real data.xlsx بجوار الملف الذي اسمه (Total.xlsx )

الكود سوف يحذفه ووضع مكانه ملف باسم (Total.xlsb )

2- انسخ الكود التالي

3- اربط  الزر قي صفحة ( total  ) بالكود الذي اسمه ( total  )

4- ثم اضغط على الزر

5- سوف يعمل الكود ويجلب البيانات الموجوده في جميع الشيتات ماعدا ٣ شيتات معينة  وهما ( summery  )  (Hold ) (Time )

Sub Total()
    Dim WS As Worksheet, WB As Workbook, SH As Worksheet
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Set SH = ThisWorkbook.Worksheets("Total")
    Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "real data.xlsx", False)
        For Each WS In WB.Worksheets
            If WS.Name <> "Total" And WS.Name <> "SUMMARY" And WS.Name <> "TIME" And WS.Name <> "HOLD" Then
                WS.Range("A6:S" & WS.Cells(Rows.Count, 2).End(xlUp).Row).Copy _
                SH.Range("A" & SH.Cells(Rows.Count, 2).End(xlUp).Row + 1)
            End If
        Next WS
    WB.Close Savechanges:=True
    SH.Columns.AutoFit
    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Total", FileFormat:=xlExcel12
    On Error Resume Next
    Kill ThisWorkbook.Path & "\" & "Total.xlsx"
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub

الحمد لله الذي بنعمته تتم الصالحات 

السلام عليكم ورحمة الله وبركاته 

على حسب فهمى لسؤالك

بعد اذن الاستاذ حسين 

عدل هذا السطر 

Sheets("P.R.T").PrintOut Copies:=x, Collate:=True, _
        IgnorePrintAreas:=False

الى هذا السطر 

Sheets("P.R.T").PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False

اخى الكريم يمكنك الاستفادة من هذا  الموضوع

وعليكم السلام ورحمة الله وبركاته 

الملف الخاص بك ليس به مشاكل

آمين يارب العالمين وإياكم 

الحمد لله الذي بنعمته تتم الصالحات 

يمكنك الاستفادة من هذا الموضوع هنا فيه الموضوع الاصلي للبرنامج

في ١٦‏/١١‏/٢٠٢١ at 19:31, بن علية حاجي said:

ملاحظة: يجب أن يكون رقم التسلسل في ورقة "البيانات" بالعمود A في السطر الأول من جدول كل عميل (كما فعلتُ للأرقام الأرقام 1، 2، 3، 4)...

اخى الكريم محمد عبدالصمد هل كتبت الارقام من ٥ الى نهايه ارقامك ال ٥٠٠٠ اسم كما طلب منك الاستاذ الكبير بن علية حاجى في المشاركه السابقه

اجعل تنسيق الخلايا

general

وستجد المعادله سليمه

الكود الخاص بك كان فيه حلقه تكراريه لطباعه جميع النطاق حتى لو كان لايوجد بيانات في النطاق فعدلت لك الكود بحيث ان لم يكن يوجد بيانات يتوقف الكود

If Isnull([d12]) or [d12] = 0 then Exit 

وعليكم السلام ورحمة الله وبركاته 

الحمد لله بنعمه 

تفضل جرب هذا التعديل لعله يفي بالمطلوب

test.xlsm