كود ترحيل للمثال المرفق

[tabakh1975]

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

اريد من فضلكم كود لترحيل الحركة اليومية الى صفحة العملاء حسب اسم العميل  حتى لو زاد عدد العملاء الى عدد اوراق اخرى كثيرة مع عدم تكرار البيانات المرحلة كل مرة او مسحها ونسخها مرة اخرى من صفحة كل عميل

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

مرفق مثال

مثال.xlsm

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

حرب هذا الكود

Sub tarheel()
Dim S_Sh As Worksheet: Set S_Sh = Sheets("حركة يومية")
Dim My_Sh As Worksheet
Dim S_Rg As Range
Dim  lr_final%
Dim t%, k%: k = Sheets.Count
Dim lr%: lr = S_Sh.Cells(Rows.Count, 1).End(3).Row
Set S_Rg = S_Sh.Range("a1:h" & lr)
 For i = 4 To k
   Set My_Sh = Sheets(i)
      lr_final = My_Sh.Cells(Rows.Count, 1).End(3).Row + 1

    For t = 2 To lr
     If S_Rg.Cells(t, 7) = My_Sh.Name Then
      My_Sh.Cells(lr_final, 1).Resize(1, 7).Value = _
      S_Sh.Cells(t, 1).Resize(1, 7).Value
      lr_final = lr_final + 1
     End If
     
    Next

    Next
End Sub

 

[tabakh1975]

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

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

اسف على الازعاج

 

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

تم التعديل على الكود لعدم نقل التكرار(ليعمل الماكرو يجب الا تكون خانة التاريخ فارغة في الورقة "حركة يومية")

Sub tarheel()
Dim S_Sh As Worksheet: Set S_Sh = Sheets("حركة يومية")
Dim My_Sh As Worksheet
Dim S_Rg As Range, rg_to_copy As Range
Dim My_Item$, lr_final%
Dim t%, k%: k = Sheets.Count
Dim lr%: lr = S_Sh.Cells(Rows.Count, 1).End(3).Row
Set S_Rg = S_Sh.Range("a1:h" & lr)
Dim str$: str = "OK"
 For i = 4 To k
   Set My_Sh = Sheets(i)
      lr_final = My_Sh.Cells(Rows.Count, 1).End(3).Row + 1

    For t = 2 To lr
     If S_Rg.Cells(t, 7) = My_Sh.Name Then
       If S_Sh.Cells(t, "xfd") <> str Then
      My_Sh.Cells(lr_final, 1).Resize(1, 7).Value = _
      S_Sh.Cells(t, 1).Resize(1, 7).Value
      lr_final = lr_final + 1
      S_Sh.Cells(t, "xfd") = str
      End If
     End If
     
    Next

    Next
End Sub

الملف مرفق

 

salim's exemple.xlsm

[tabakh1975]

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

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

ما هو اصدار  الاكسل عندك 

اذا كان ما دون 2007 استبدل    "xfd"  في الكود بــــ   "BZ"

[tabakh1975]

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

عندي اكسيل 2010

 

[wahid-chaoui]

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

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

لكنني مازلت مبتدئ ووجدت ملف احتاجه في عملي لكن لم اجد الحل لكي يرحل البيانات حسب كل صفحة عميل على انفراد

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

فاتورة جديدة7.xls