الكود التالي ينفذ لك ما تريد:
Sub Tarheel()
Sheet2.[A6:G65536].ClearContents
For R = 6 To [A65536].End(xlUp).Row
If Cells(R, 6) = 8 Then
With Sheet2.[A65536].End(xlUp)
.Offset(1, 0) = Sheet1.Cells(R, 1)
.Offset(1, 1) = Sheet1.Cells(R, 2)
.Offset(1, 2) = Sheet1.Cells(R, 3)
.Offset(1, 3) = Sheet1.Cells(R, 4)
.Offset(1, 4) = Sheet1.Cells(R, 5)
.Offset(1, 5) = Sheet1.Cells(R, 6)
.Offset(1, 6) = Sheet1.Cells(R, 7)
End With
End If
Next
MsgBox "!تم ترحيل الصفوف المطلوبة بنجاح", vbInformation, "تم الترحيل"
End Sub
شاهد المرفق،
__________________________________________8.rar