将复制行偏移为循环的一部分 [英] Offset the Copy Row as part of a Loop

问题描述

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

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).

是这样吗?

   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工作表并将行添加到BUYSHEET的底部

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

这篇关于将复制行偏移为循环的一部分的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！