作为循环的一部分偏移复制行

Question

我已经编写了以下代码，但我希望宏重复此过程，将下一行复制到 SS21 主表中，直到该行为空白（表格末尾）。

像这样？

   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 主表

购买表

Answer 1

这会扫描 MASTER 表并将行添加到 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