How to create loop in excel for copy paste - excel

Question

I'm trying to copy and past transpose and there is many rows.
The following code get from record macro, how to create loop upto L1000:N1000 in sheet2?
Sub Macro4()
Sheets("sheet2").Select
Range("L5:N5").Select
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("sheet2").Select
Range("L6:N6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("B14").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("sheet2").Select
Range("L7:N7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
ActiveWindow.SmallScroll Down:=6
Range("B24").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

Answer 1

Since you are copying across as Paste Special Paste:=xlPasteAll, Transpose:=True, I retained that to keep your formulas and formatting. If only values were desired to be brought across in a transposed array, there are other methods that would be faster.
This starts with the destination as B4 and adds 10 rows to each successive loop; e.g. B4, B14, B24, etc.
Sub Copy_From_WS1_to_WS2_by_10()
Dim rw As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With Sheets("Sheet1")
For rw = 4 To 1000
.Cells(rw, 12).Resize(1, 3).Copy
Sheets("Sheet2").Cells(4 + (rw - 4) * 10, 2).PasteSpecial _
Paste:=xlPasteAll, Transpose:=True, Operation:=xlNone, SkipBlanks:=False
Application.CutCopyMode = False
Next rw
End With
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I've returned the calculation mode to Automatic at the end of the macro. Remove or comment that line if you wish it to remain manual.