بعض طرق ترحيل البيانات

 Sub TRans()  

   Dim myArray() As Variant  

   myArray = Range("B5:J" & Cells(Rows.Count, 3).End(xlUp).Row)  

   Sheet2.Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(UBound(myArray, 1), UBound(myArray, 2)).Value = myArray  

   MsgBox "DONE....", 64  

 End Sub

 Sub TRans1()  

   Application.ScreenUpdating = False  

   Range("B5:J" & Cells(Rows.Count, 3).End(xlUp).Row).Copy  

   Sheet2.Range("B" & Sheet2.Cells(Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial (xlPasteValues)  

   Application.CutCopyMode = False  

   Application.ScreenUpdating = True  

   MsgBox "DONE....", 64  

 End Sub