مساعده فى الترحيل حسب الاسم

[اركان الاسلام]

    ارجو المساعده عاوز ارحل من شيت اساسى الى شيتات حسب اسم العميل

 

ترحيل حسب اسم العميل.xlsm

[Ali Mohamed Ali]

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

ترحيل من صفحة الى عدة صفحات بإسم الصفحة

[سليم حاصبيا]

ممكن نجربة هذا الكود

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

Option Explicit

Sub Add_sheet()
 Dim myname As Worksheet
 Dim P As Worksheet
 Dim sh_n%, k%, i%
 Set P = Sheets("اليوميه")
 sh_n = Application.CountA(P.Range("B:B")) - 1
 Dim x%, t%: t = 2
 Dim mn$
Application.ScreenUpdating = False
  '''''''''''''''''''''''''''''''''''''''''
  For i = 2 To sh_n
               On Error Resume Next
               mn = Sheets(P.Range("b" & i) & "").Name
               x = Len(mn)
        If x = 0 Then
            P.Copy after:=Sheets(Sheets.Count)
             With ActiveSheet
             .Name = P.Range("b" & i)
             .Range("G14") = P.Range("F" & i)
             .Range("a1").CurrentRegion.Offset(1).ClearContents
             .Range("A:A").NumberFormat = ("dd- mm-yyy")
              For k = 2 To sh_n + 1
              If P.Range("b" & k) = ActiveSheet.Name Then
               ActiveSheet.Cells(t, 1).Resize(, 4).Value = _
               P.Range("A" & k).Resize(, 4).Value
               t = t + 1
              End If
              Next
            End With
            '=========================================
        Else
            
            Set myname = Sheets(P.Range("b" & i) & "")
            myname.Range("a1").CurrentRegion.Offset(1).ClearContents
            For k = 2 To sh_n + 1
              If P.Range("b" & k) = myname.Name Then
               myname.Cells(t, 1).Resize(, 4).Value = _
               P.Range("A" & k).Resize(, 4).Value
               t = t + 1
        End If
              Next
              
         ''''''''''''''''''''''''''''''''''''
  End If
    mn = ""
    Err.Number = 0
    t = 2
   Next i
   P.Select
 Application.ScreenUpdating = True

End Sub

الملف مرفق

 

 

tarhil_by_names.xlsm

[اركان الاسلام]

يا اخى بارك الله فيك هو ده الى انا عاوزه بالظبط بل اكثر

 

ولكن مش عارف ليه كل الشيتات الى بحملها من على الموقع مبتشغلشى عندى 

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

ديما بتطلع رساله بس مش عارف اخدها شوت من شاشه الجهاز 

 بدعيله عن ظهر قلب

اللهم اصلح له شانه كله

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