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

时间:2014-10-31 09:32:49

标签: excel vba excel-vba

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

  1. 第1行将是标题
  2. 第2行将包含要复制的数据
  3. 第3行与上面的第2行相同
  4. 重复下来。
  5. 在数据行中,列M中的单元格将包含一个数字,该数字可以为每行更改,因此这将更改粘贴时间。

    我想复制&将完整数据粘贴到行中,例如2,按M2中显示的数字粘贴。如果M24,那么来自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 :(得分: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