Offset the Copy Row as part of a Loop - excel

Question

I have written the below code but i would like the macro to repeat this process, copying the next row down in the SS21 Master Sheet until that row is blank (the end of the table).
Something like this?
Sub Run_Buysheet()
Sheets("SS21 Master Sheet").Range("A1:AH1, AJ1:AK1, AQ1").Copy Destination:=Sheets("BUYSHEET").Range("A1")
Sheets("SS21 Master Sheet").Range("A2:AH2, AJ2:AK2, AQ2").Copy Destination:=Sheets("BUYSHEET").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Dim r As Range, i As Long, ar
Set r = Worksheets("BUYSHEET").Range("AK999999").End(xlUp) 'Range needs to be column with size list
Do While r.Row > 1
ar = Split(r.Value, "|") '| is the character that separates each size
If UBound(ar) >= 0 Then r.Value = ar(0)
For i = UBound(ar) To 1 Step -1
r.EntireRow.Copy
r.Offset(1).EntireRow.Insert
r.Offset(1).Value = ar(i)
Next
Set r = r.Offset(-1)
Loop
End Sub
SS21 Master Sheet
BUYSHEET

Answer 1

This scans the MASTER sheet and adds rows to the bottom of the BUYSHEET
Sub runBuySheet2()
Const COL_SIZE As String = "AQ"
Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet
Set wb = ThisWorkbook
Dim iLastRow As Long, iTarget As Long, iRow As Long
Dim rngSource As Range, ar As Variant, i As Integer
Set wsSource = wb.Sheets("SS21 Master Sheet")
Set wsTarget = wb.Sheets("BUYSHEET")
iLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row
iTarget = wsTarget.Range("AK" & Rows.Count).End(xlUp).Row
With wsSource
For iRow = 1 To iLastRow
Set rngSource = Intersect(.Rows(iRow).EntireRow, .Range("A:AH, AJ:AK, AQ:AQ"))
If iRow = 1 Then
rngSource.Copy wsTarget.Range("A1")
iTarget = iTarget + 1
Else
ar = Split(.Range(COL_SIZE & iRow), "|")
For i = 0 To UBound(ar)
rngSource.Copy wsTarget.Cells(iTarget, 1)
wsTarget.Range("AK" & iTarget).Value = ar(i)
iTarget = iTarget + 1
Next
End If
Next
MsgBox "Completed"
End With
End Sub