كود ترحيل

[Armia Nabil]

اريد معادله او كود vba 

ترحل من الشيت الاول الي الشيت التاني حسب التاريخ 

ترحيل اعمده اليوم الي الصفحه التانيه حسب التاريخ 

وشكرااا

Book1.xlsx

[محي الدين ابو البشر]

Sub test()
Dim a, x, w
Dim i&, ii&
Dim r As Range
a = Sheets("sheet1").Cells(1).CurrentRegion
With CreateObject("scripting.dictionary")
        For i = 2 To UBound(a)
            For ii = 2 To UBound(a, 2): x = IIf(x = "", a(i, ii), x & "|" & a(i, ii)): Next
            If Not .exists(a(i, 1)) Then
                    .Add a(i, 1), x: x = ""
             Else
            .Item(a(i, 1)) = .Item(a(i, 1)) & "#" & x: x = ""
            End If
        Next
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
      For Each x In .keys
       Set r = Sheets("sheet2").Cells.Find(x, , , 1).Cells
        x = Split(.Item(x), "#")
        With Sheets("sheet2")
            With r.Offset(, 1).Resize(UBound(x))
                .Value = Application.Transpose(x)
             .TextToColumns r.Offset(, 1), 1, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(7, 1))
       End With: End With
        Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

Book1.xlsm

[Armia Nabil]

الف شكر لتعبك 

بس البيانات بتعه مثلا يوم 1\5   6 اسطر مرحله 5 فقط لو تم  اضافه بيانات وتواريخ تاني بيقولي خطا 

الف شكر لتعبك 

[محي الدين ابو البشر]

عذراً

خطأ طباعي

Book1.xlsm

تم تعديل مايو 21, 2023 بواسطه محي الدين ابو البشر

[Armia Nabil]

الف شكرررررررر لحضرتك 

[محي الدين ابو البشر]

بارك الله

[كمال على طارق]

Armia Nabil   عنوان مخالف جداً لابد من تعديل وتغيير عنوان المشاركة ليعبر عن طلبك وحتى يسهل البحث بالمنتدى مستقبلاً لمن له مث طلبك !!!