اريد مساعدة في تعديل كود ترحيل

[ماجد القثمي]

السلام عليكم

اخواني كتبت كود لترحيل بيانات من ورقه الى ورقه اخرى داخل جدول من 3 اقسام اعددته مسبقا

اريد ان ينتقل الترحيل من الجدول الاول الى الثاني الى الثالث في حال امتلاء الجدول الذي قبله بالبيانات

الكود الذي عملته استطعت وضع شرط في حال امتلا الجدول الاول انتقل الى الثاني ولكن لم استطع عمل شرط اخر للانتقال الى الجدول الثالث في حال امتلا الجدول اثاني ايضا

بقيه الشرح في الملف المرفق

 وشكرا

<<Sub test()

'Transfer order from top items table

For r = 4 To 57

If Cells(6, r).Value <> Empty Then

Cells(3, r).Copy

 

If Sheets("order").Cells(43, 3).Value <> Empty Then

Sheets("order").Cells(4, 7).End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

Else

Sheets("order").Cells(4, 3).End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

End If

 

Cells(6, r).Copy

If Sheets("order").Cells(43, 4).Value <> Empty Then

Sheets("order").Cells(4, 8).End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

Else

Sheets("order").Cells(4, 4).End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

End If

End If

Next

 

'Transfere order from bottom items table

For s = 4 To 59

If Cells(12, s).Value <> Empty Then

Cells(9, s).Copy

 

If Sheets("order").Cells(43, 3).Value <> Empty Then

Sheets("order").Cells(4, 7).End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

Else

Sheets("order").Cells(4, 3).End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

End If

 

Cells(12, s).Copy

If Sheets("order").Cells(43, 4).Value <> Empty Then

Sheets("order").Cells(4, 8).End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

Else

Sheets("order").Cells(4, 4).End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

End If

 

 

End If

Next

End Sub>>

تعديل الى داخل الجدول.rar

[ماجد القثمي]

للرفع