الترحيل على حسب الحي

[محسن33]

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

لدي اكثر من 10000 صف

واكثر من 70 عميل في احياء مختلفة

ارجو كود الترحيل للمثال المرفق على حسب اسم الحي(الورقة

يعطيكم العافية

 

ترحيل.rar

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

يمكن ان يكون الحل (في حال اضافة احياء جديدة يتم انشاء صفحات جديدة لها)

الكود

Option Explicit

Sub CreateSheets_WITH_FILTER()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim FILTER_RG As Range
    Dim ListSh As Range
    Dim i%, last_row As Long
    Dim Y$, SALIM As Range
    Dim Sw_sh As Worksheet
    
     Set Sw_sh = Sheets("مبيعات")
        With Sw_sh
            last_row = .Cells(.Rows.Count, "E").End(xlUp).Row
            Set ListSh = .Range("E2:E" & last_row)
            Set FILTER_RG = .Range("B1:F" & last_row)
        End With
      On Error Resume Next
    For Each SALIM In ListSh
        If Len(Trim(SALIM.Value)) > 0 Then
          Y = Worksheets(Trim(SALIM.Value)).Name
          If Y = vbNullString Then
              Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SALIM.Value
          End If
            Y = Empty
         End If
      Next SALIM
      
    Sw_sh.Select
     
 For i = 2 To Sheets.Count
     With Sheets(i)
      .Cells.Clear
      .Range("a1") = "حساب " & .Name
      .Columns("B:F").ColumnWidth = 12.85
     End With
     Next
    For i = 2 To Sheets.Count
    
        If FILTER_RG.AutoFilter = False Then FILTER_RG.AutoFilter
        FILTER_RG.AutoFilter FIELD:=4, Criteria1:=Sheets(i).Name
        FILTER_RG.SpecialCells(2, 23).Copy Sheets(i).Range("B2")
        FILTER_RG.AutoFilter
     Next
   Application.ScreenUpdating = True
End Sub

الملف

ترحيل salim.xlsm

[محسن33]

اشكرك على الاستجابة السريعة جاري التجربة 

مشكور ولو لي استفسار  أتمنى المشاركة

[محسن33]

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

مطعم.rar

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

تم عمل ذلك يعون الله

 

مطعم Salim.xlsm

[محسن33]

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

 الأخ سليم حاصبيا بارك الله فيكم

هو المطلوب

الله يوفقك

[ابو حمادة]

7 ساعات مضت, سليم حاصبيا said:

تم عمل ذلك يعون الله

 

مطعم Salim.xlsm

عمل متميز اخى واستاذي الغالي

7 ساعات مضت, سليم حاصبيا said:

تم عمل ذلك يعون الله

 

مطعم Salim.xlsm

الله ينور عليك استاذي الغالي 

سليم حاصبيا 

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

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

الترحيل يتم على حسب المنطقه الموجود فى العمود (H)

علما  انه يوجد شرط للترحيل وهو لا يتم ترحيل اي اسم امامه كلمة مستبعد في العمود (i)

ويوجد استفسار أخر

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

ترحيل.rar

7 ساعات مضت, سليم حاصبيا said:

تم عمل ذلك يعون الله

 

مطعم Salim.xlsm