هذا هو الكود
Sub OFFICNA()
Dim LR As Long, LR2 As Long, ws As Worksheet, ws2 As Worksheet
Set ws = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
LR = ws.Range("a" & Rows.Count).End(xlUp).Row
LR2 = ws2.Range("a" & Rows.Count).End(xlUp).Row
If ws.Range("a2").Value = "" Then
MsgBox ("لا توجد بيانات لترحيلها")
Else
ws.Range("a2:b" & LR).Copy ws2.Range("a" & LR2 + 1)
ws2.Select
End If
End Sub
هذا الجزء لتعريف أوراق العمل وتعريفها برمز إختصار اخترت ان يكون ws و ws2
Set ws = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
هذا لتحديد أخر صف فيه بيانات في ورقة العمل المعرفة اختصاراً ws والتي هي Sheet1
LR = ws.Range("a" & Rows.Count).End(xlUp).Row
هذا لتحديد أخر صف فيه بيانات في ورقة العمل المعرفة اختصاراً ws2 والتي هي Sheet2
LR2 = ws2.Range("a" & Rows.Count).End(xlUp).Row
هذا شرط عدم الترحيل اذا كانت الخلية A2 فاضية وتظهر رسالة تنبيه بعدم التنبيه
If ws.Range("a2").Value = "" Then
MsgBox ("لا توجد بيانات لترحيلها")
في حال عدم تحقق شرط خلو الخلية A2 من البيانات يتم تنفيذ هذا الجزء
وهو الخاص بعملية نسخ المدى A2: B مرتبطة بأخر صف فيه بيانات LR ويتم لصقها في ورقة البيانات المسمية WS2 في المدى A وأول صف فارغ في الورقة المرحل اليها ws2
ws.Range("a2:b" & LR).Copy ws2.Range("a" & LR2 + 1)
هذا الجزء لاختيار ورقة العمل ws2 بعد الانتهاء من الترحيل
ws2.Select
ان شاء الله اكون وفقت في الشرح
أما بالنسبة لطلبك فهو غير واضح؟؟