重复复制/粘贴和循环

Question

我有一张纸，上面有关于衣物的数据。每行包含有关1条衣服行的所有数据，例如植物区系连衣裙，即粉红色，大小为8 | 10 | 12 | 14 | 16 | 18（在SS21“主”选项卡上）。

在一个新选项卡上，我需要分割此数据，以便每个大小都位于其自己的行上，但所有其他数据列均保持不变（“购买表”选项卡。

我已经找到了一种方法来为我的表的第2行运行此方法，但是无法解决如何对第3、4、5行重复此过程（依此类推，直到表的末尾-表的大小经常更改） 。

SS21主表：

[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

我有一张纸，上面有关于衣物的数据。每行包含有关1条衣服行的所有数据，例如植物区系连衣裙，即粉红色，大小为8 | 10 | 12 | 14 | 16 | 18（在SS21上...

Answer 1

[不知道您的电子表格的布局，这是我的最佳建议。我会以另一种方式进行循环，以便可以将i和Offset都使用。我会操纵ar(i)，所以您不必更改Offset。