首页 文章

根据单元格值复制/粘贴X次

提问于
浏览
1

我想复制整行并将值粘贴到另一个工作表中 .

  • 第1行将是 Headers

  • 第2行将包含要复制的数据

  • 第3行与上面的第2行相同

  • 重复下来 .

在数据行中, M 列中的单元格将包含一个数字,该数字可以为每一行更改,因此这将更改粘贴时间 .

我想用M2中显示的数字复制并粘贴行中的完整数据,比如2 . 如果 M2 具有 4 ,那么来自sheet1的第2行将被复制到第2页,相互复制四次 .

表1有16列数据,如下所示

Aa Bb Cc Dd Ee Ff Gg Hh Ii Gg Kk Ll **4** Nn Oo Pp

当宏运行时,它在Sheet2中看起来像这样

Aa Bb Cc Dd Ee Ff Gg Hh Ii Gg Kk Ll **4** Nn Oo Pp<br>
Aa Bb Cc Dd Ee Ff Gg Hh Ii Gg Kk Ll **4** Nn Oo Pp<br>
Aa Bb Cc Dd Ee Ff Gg Hh Ii Gg Kk Ll **4** Nn Oo Pp<br>
Aa Bb Cc Dd Ee Ff Gg Hh Ii Gg Kk Ll **4** Nn Oo Pp<br>

这就是我所拥有的

Sub CopyRowsXTimes()
    Dim rngCell As Range

    ThisWorkbook.Worksheets("Sheet2").Cells.ClearContents
    For Each rngCell In ThisWorkbook.Worksheets("Sheet1").Range("N2:N" & _
    Cells(Rows.Count, 14).End(xlUp).Row)
        With ThisWorkbook.Worksheets("Sheet2")
            .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, _
            1).Resize(rngCell.Value, 5).Value = rngCell.Offset(, -3).Resize(1, 5).Value
        End With
    Next rngCell

    Set rngCell = Nothing
End Sub

唯一的问题是它只复制了前4列 . 但我希望复制整行 . 目前有16列,但未来可能会增长 .

1 回答

  • 0

    实际上它非常简单 . 试试这个( UNTESTED

    Sub Sample()
        Dim wsI As Worksheet, wsO As Worksheet
        Dim lRow_I As Long, lRow_O As Long, i As Long, j As Long
    
        '~~> Set your input and output sheets
        Set wsI = ThisWorkbook.Sheets("Sheet1")
        Set wsO = ThisWorkbook.Sheets("Sheet2")
    
        '~~> Output row
        lRow_O = wsO.Range("A" & wsO.Rows.Count).End(xlUp).Row + 1
    
        With wsI
            '~~> Get last row of input sheet
            lRow_I = .Range("A" & .Rows.Count).End(xlUp).Row
    
            '~~> Loop through the rows
            For i = 2 To lRow_I
                '~~> This will loop the number of time required
                '~~> i.e the number present in cell M
                For j = 1 To Val(Trim(.Range("M" & i).Value))
                    '~~> This copies
                    .Rows(i).Copy wsO.Rows(lRow_O)
                    '~~> Get the next output row
                    lRow_O = wsO.Range("A" & wsO.Rows.Count).End(xlUp).Row + 1
                Next j
            Next i
        End With
    End Sub
    

相关问题