استدعاء بيانات من ملف اخر مع تجاهل التكرار وتكرار تاريخ

[أبو عبد الله _]

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

أود أن اشكر جميع القائمين على المنتدى 

وقد حاولت أن أجد حلول لكن تعذر البحث 

وقد وجدت جزء من المطلوب ( تصفية الاسماء )

المطلوب :

1- في ورقة المبيعات كود يقوم باعادة كتابة التاريخ في الخلايا الفارغة اسفل تاريخ معين بنفس التاريخ السابق 

2- جلب البيانات من ورقة المبيعلت في الملف الثاني والثالث وادراجها في مبيعات الملف الأول مع تجاهل المكرر 

3- في ورقة الاسماء من الملف الأول مطلوب ترتيب الاسماء أبجديا مع حذف المكرر لعمل قائمة منسدلة 

ويفضل خط كبير 

 

 

ملفات الاستدعاء.rarFetching info...

تم تعديل فبراير 6, 2023 بواسطه أبو عبد الله _

[أبو عبد الله _]

يمكن الاستغناء عن المطلوب ٣ اما الاول والثاني مهمين 

ويمكن جلب البيانات من ملف واحد فقط لا يشترط القالث

[أبو إيمان]

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

كود المطلوب الأول ويمكن توظيفه بحسب رغبتك  ( وضعه في حدث الورقة أو عمل حلقة تكرارية من البداية للنهاية )

Sub dat()
Application.ScreenUpdating = False
On Error Resume Next
  رقم اخر صف يحتوي على تاريخ
    lr = [d10000].End(xlUp).Row
رقم اخر صف يحتوي على بيانات
    n_lr = [f10000].End(xlUp).Row
حلقة تكرارية تبداء     
    For X = lr To n_lr
اذا كان اخر خلية في العمود d
If Cells(n_lr, 4) = "" Then
قم بجعلى الخلية التالية تساوى الخلية السابقة في نفس العمود
Cells(lr + 1, 4) = Cells(lr, 4)
End If
قم بالنزول صف يلي صف التاريخ
lr = lr + 1
اعادة الحلقة التكرارية
Next

       
    
End Sub

 

تم تعديل فبراير 8, 2023 بواسطه أبو إيمان

[lionheart]

Peace be upon you. You have to be more organized and specific in your explanation to the problem

Create a new workbook with `xlsm` extension in the same path of your files and name it `MAIN.xlsm`, then open the workbook

Press Alt + F11 to login VBE then insert a new module, put the following code

Sub Get_Data_From_Closed_Workbooks()
    Dim a, wb As Workbook, ws As Worksheet, sFile As String, sPath As String, lr As Long, m As Long
    Application.ScreenUpdating = False
        sPath = ThisWorkbook.Path & "\"
        sFile = Dir(sPath & "*.xlsx")
        m = 2
        With shSales.Range("B1").CurrentRegion.Offset(1)
            .ClearContents: .Borders.Value = 0
        End With
        Do While sFile <> ""
            Set wb = Workbooks.Open(sPath & sFile, ReadOnly:=True)
            Set ws = wb.Sheets(2)
            With ws
                lr = .Cells(Rows.Count, "E").End(xlUp).Row
                a = .Range("B2:H" & lr).Value
                .Parent.Close False
            End With
            shSales.Range("B" & m).Resize(UBound(a, 1), UBound(a, 2)).Value = a
            m = m + UBound(a, 1)
            sFile = Dir()
        Loop
        With shSales.Range("B2:H" & m - 1)
            .Borders.Value = 1
        End With
        With shSales.Range("D2:D" & m - 1)
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
            .Value = .Value
        End With
    Application.ScreenUpdating = True
    MsgBox "Done", 64
End Sub

 

 

I will attach the file just for you. Click on the icon in the quick access bar

 

MAIN.xlsmFetching info...

تم تعديل فبراير 8, 2023 بواسطه lionheart

[أبو عبد الله _]

الاستاذ ابو ايمان

جزاكم الله خيراً

وشكراً على الفكرة

الاستاذ قلب الأسد

شكرا على الكود الرائع الذي قدمته 

لكن عندي استفسار 

ما المقصود بان يتم الشرح اكثر تنظيما 

 

هل يمكن جلب البيانات من ملفات الاكسيل بامتدادات مختلفة مثلا ملفات امتداد xlsx

وملفات xlsm ( إذا صعب يمكن ان اقوم بتحويل الامتدادات) ولك وافر الشكر

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

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

تم تعديل فبراير 8, 2023 بواسطه أبو عبد الله _

[أبو إيمان]

الاخ الفاضل lionheart

كود جميل 

كيف تم عمل اختصار للكود في شريط العنوان

[أبو عبد الله _]

الاستاذ قلب الاسد lionheart

الكود يجلب البيانات إلى الملف main من الملفات الاخرى وهذا جيد 

لكن عند اضافة بيانات في main والملفات الاخرى وتنفيذ الكود مرة اخرى يتم حذف البيانات المضافة في main 

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

السلام عليكم

حتى يكون المطلوب اكثر وضوحا

في الملف main الصف ٣٨ الى الصف ٤٠ يحتوي على بيانات غير الموجودة في الثاني والثالث 

المطلوب عند استدعاء البيانات من الملفات الاخرى ان تظل البيانات الموجودة في main كما هي 

فقط يستدعي المختلف من الملف الثاني والثالث وهي البيانات المظللة باللون الازرق 

( يستدعي البيانات الجديدة والمختلفة من الملفات الاخرى وتوضع مع البيانات في main ولا يتم حذف ببانات main

New folder.rarFetching info...

 

إذا فشلت في الشرح للمطلوب الرجاء الاشارة الى ذلك وسوف اقوم بالتصحيح

 

[lionheart]

Not so clear for me

Here's the modified code that enables you to add new data without clearing the existing data

Sub Get_Data_From_Closed_Workbooks()
    Dim a, wb As Workbook, ws As Worksheet, sFile As String, sPath As String, lr As Long, m As Long
    Application.ScreenUpdating = False
        sPath = ThisWorkbook.Path & "\"
        sFile = Dir(sPath & "*.xlsx")
        m = shSales.Cells(Rows.Count, "E").End(xlUp).Row + 1
'        With shSales.Range("B1").CurrentRegion.Offset(1)
'            .ClearContents: .Borders.Value = 0
'        End With
        Do While sFile <> ""
            Set wb = Workbooks.Open(sPath & sFile, ReadOnly:=True)
            Set ws = wb.Sheets(2)
            With ws
                lr = .Cells(Rows.Count, "E").End(xlUp).Row
                a = .Range("B2:H" & lr).Value
                .Parent.Close False
            End With
            shSales.Range("B" & m).Resize(UBound(a, 1), UBound(a, 2)).Value = a
            m = m + UBound(a, 1)
            sFile = Dir()
        Loop
        With shSales.Range("B2:H" & m - 1)
            .Borders.Value = 1
        End With
        With shSales.Range("D2:D" & m - 1)
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
            .Value = .Value
        End With
    Application.ScreenUpdating = True
    MsgBox "Done", 64
End Sub

The point of duplicates is not clear at all

 

As for creating a shortcut icon, you can do that following the quick access bar

 

 

[أبو عبد الله _]

الاستاذ قلب الأسد 

أشكر لك مجهودك وتعبك 

سوف أقوم بالتجربة وإبلاغك النتيجه إن شاء الله 

[أبو عبد الله _]

Retrieving data from the second and third files and deleting duplicate invoices. In other words, fetching blue-shaded data from the second and third files.
Provided that the data entered in the main file is preserved
shaded in yellow

In other words I need Just different data from second  and three

In other word i need keep old data

Without duplicated invoice

 

 

New folder.rarFetching info...

[أبو عبد الله _]

Up