Offset the Copy Row as part of a Loop

问题

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

回答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

来源：https://stackoverflow.com/questions/60111198/offset-the-copy-row-as-part-of-a-loop

标签

excel

vba

loops

copy-paste

offset