복사/붙여 넣기 셀 값을 기준으로 X 횟수

Question

전체 행을 복사하여 값을 다른 워크 시트에 붙여 넣으 려합니다.

e.e.

1. 행 1
2. 아래 반복 상기 2 행
등
3. 3 행 같은 복사 될 데이터를 포함하는 것 헤더
4. 행 2 것이다.

데이터 행 내에서이 번호가 각 행에 대해 변경할 수있는 숫자를 포함하는 M 열에 셀이 있습니다. 이렇게하면 붙여 넣기 시간이 변경됩니다.

& 전체 데이터 (예 : 2)를 M2에 표시된 번호로 복사합니다. M2에 4이 있으면 sheet1의 2 번 행이 2 번 시트에 4 번 복사됩니다. 매크로가 삽입하거나이 같을 것이다 실행하면

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

아래와 같이

시트 (1)는 데이터의 16 열이

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 개의 기둥이 있지만 미래에는 커질 수 있습니다.

Answer 1

사실 아주 간단합니다. 시도해보십시오 (테스트되지 않음)

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