Question

我试图根据表1中H列所示的值，将第1页中的行复制到表2上。

我找到了一个似乎有效的代码，但它更改了原始工作表中的数据，而不是将行复制到另一个工作表中，比如＆＃34; Sheet2＆＃34;。

＆＃13;

Sub CopyData()
'Updateby Extendoffice 20160922
    Dim xRow As Long
    Dim VInSertNum As Variant
    xRow = 1
    Application.ScreenUpdating = False
    Do While (Cells(xRow, "A") <> "")
        VInSertNum = Cells(xRow, "H")
        If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
           Range(Cells(xRow, "A"), Cells(xRow, "H")).Copy
           Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "H")).Select
           Selection.Insert Shift:=xlDown
           xRow = xRow + VInSertNum - 1
        End If
        xRow = xRow + 1
    Loop
    Application.ScreenUpdating = False
End Sub

＆＃13;

如何更改此代码，使其在原始提取工作表中运行宏＆＃34; Sheet1＆＃34;并将行复制到＆＃34; Sheet2＆＃34;，如果H列中的值大于0？

Sheet1中的示例数据如下所示。容器中的值位于H列中，它确定要复制的行数＆amp;复制到Sheet2。

Supplier    Dest    Code     Quantity Container
A           US01    10001    1000     2
A           US02    10002    500      4
B           UK01    10001    0        0
C           US01    10004    1300     1

Sheet2中的所需结果如下：

Supplier    Dest    Code     Quantity Container
A           US01    10001    1000     2
A           US01    10001    1000     2    
A           US02    10002    500      4
A           US02    10002    500      4
A           US02    10002    500      4
A           US02    10002    500      4
C           US01    10004    1300     1

谢谢。

Answer 1

我知道这个问题很旧，但是没有答案，所以我认为可以提交一个问题。

我创建了一个新宏，我认为它会更简单，更易于阅读和理解。所有这些使您以后需要更改时可以更轻松地进行编辑。

据我了解，您在D列至H列中有要重复 x 次的信息；其中 x 是H列中的值。我假设您的工作表分别命名为“ Sheet1”和“ Sheet2”。我在下面提供了答案。

Dim wsc As Worksheet 'worksheet copy
Dim wsd As Worksheet 'worksheet destination

Dim lrow As Long 'last row of worksheet copy
Dim crow As Long 'copy row
Dim drow As Long 'destination row

Dim multiplier As Integer
Dim i As Integer 'counting variable for the multiplier

Set wsc = Sheets("Sheet1")
Set wsd = Sheets("Sheet2")

lrow = wsc.Range("h" & wsc.Rows.Count).End(xlUp).row
drow = 2

With wsc

    For crow = 2 To lrow 'starts at 2 because of the header row

        multiplier = .Cells(crow, 8).Value 'copies the value in column h

        For i = 1 To multiplier

            wsd.Cells(drow, 4).Value = .Cells(crow, 4).Value
            wsd.Cells(drow, 5).Value = .Cells(crow, 5).Value
            wsd.Cells(drow, 6).Value = .Cells(crow, 6).Value
            wsd.Cells(drow, 7).Value = .Cells(crow, 7).Value
            wsd.Cells(drow, 8).Value = .Cells(crow, 8).Value

            drow = drow + 1 'increasing the row in worksheet destination 

        Next i

    Next crow

End With

如果有任何方法可以改善此答案，请告诉我！：）

基于单元格值重复行“x”次

1 个答案: