Try this
Sub Copy_Every_100()
Dim lrow As Long
Dim srow As Long
Dim i As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
srow = 2 'starting row set to second row
lrow = Range("A50000").End(xlUp).Offset(1, 0).Row 'change if last row is greater than 50k
i = 2 'paste row start
Do Until srow >= lrow
Cells(srow, 1).EntireRow.Copy
Sheets("Sheet2").Cells(i, 1).PasteSpecial 'Change paste sheet name
srow = srow + 100
i = i + 1
Loop
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Bookmarks