Ето един вариант с цикъл:
Sub CopyExcelTableInALoop()
Dim i As Integer
'Set counter for the current row
i = 1
'Loop through rows 1-10 in Sheet1
For i = 1 To 10
'Copy cells C1-F1 from Sheet1 to cells A2-D2 in Sheet 2
Worksheets("Sheet2").Cells(2, 1).Value = Worksheets("Sheet1").Cells(i, 3).Value
Worksheets("Sheet2").Cells(2, 2).Value = Worksheets("Sheet1").Cells(i, 4).Value
Worksheets("Sheet2").Cells(2, 3).Value = Worksheets("Sheet1").Cells(i, 5).Value
Worksheets("Sheet2").Cells(2, 4).Value = Worksheets("Sheet1").Cells(i, 6).Value
'Copy cells A4-D4 from Sheet2 to cells H1-J1 in Sheet1
Worksheets("Sheet1").Cells(i, 8).Value = Worksheets("Sheet2").Cells(4, 1).Value
Worksheets("Sheet1").Cells(i, 9).Value = Worksheets("Sheet2").Cells(4, 2).Value
Worksheets("Sheet1").Cells(i, 10).Value = Worksheets("Sheet2").Cells(4, 3).Value
'Go to next row
Next
End Sub