Hello itsmejan24,
Here is the update to add a blank between the lines on "Sheet2". The added change is in bold.
Sub CopyAndPrint()
Dim DstRng As Range
Dim DstWks As Worksheet
Dim i As Long
Dim n As Long
Dim R As Long
Dim Rng As Range
Dim RngEnd As Range
Dim SrcRng As Range
Dim SrcWks As Worksheet
Set SrcWks = Worksheets("Sheet1")
Set DstWks = Worksheets("Sheet2")
Set SrcRng = SrcWks.Range("A1")
Set DstRng = DstWks.Range("A1:B10")
Set RngEnd = SrcWks.Cells(Rows.Count, SrcRng.Column).End(xlUp)
If RngEnd.Row < SrcRng.Row Then Exit Sub Else Set SrcRng = SrcWks.Range(SrcRng, RngEnd)
For R = 1 To SrcRng.Rows.Count Step 10
Set Rng = SrcRng.Rows(R).Resize(10, 1)
For n = 1 To Rng.Rows.Count Step 2
i = i + 1
DstRng.Cells(i, 1) = Rng.Cells(n, 1)
DstRng.Cells(i, 2) = Rng.Cells(n + 1, 1)
i = i + 1
Next n
i = 0
DstWks.PrintOut
DstRng.ClearContents
Next R
End Sub
Bookmarks