投稿日:

【Excel】指定した数だけデータをコピーする

①コピー元シートを用意
※ここでは「表を複数の条件で絞り込む②」で作成したシートを使用(数量列だけ追加)

②ペーストするシートを用意

③コピーを実行するボタンを配置

④ボタン配置時の以下の画面で「マクロ名」を「CreateLabelData」として「新規作成」を押す

⑤「Microsoft Visual Basic for Applications」にて以下のコードを記載
※表の形式に応じて「★」のついた箇所の数値を変更

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub CreateLabelData()
'コピー開始行
Dim copyStartRow As Integer: copyStartRow = 5 '★
'コピー最終行
Dim copyLastRow As Integer: copyLastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
'コピー開始列
Dim copyStartCol As Integer: copyStartCol = 2 '★
'コピー終了列
Dim copyLastCol As Integer: copyLastCol = 4 '★
'数量列
Dim quantityCol As Integer: quantityCol = 5 '★
 
'ペーストするシート名
Dim pasteSheetName As String: pasteSheetName = "商品ラベルデータ" '★
'ペースト行
Dim pasteRow As Integer: pasteRow = 2 '★
'ペースト列
Dim pasteCol As Integer: pasteCol = 1 '★
'ペーストするシートの最終行
pasteLastRow = Worksheets(pasteSheetName).UsedRange.Row + Worksheets(pasteSheetName).UsedRange.Rows.Count - 1
 
'ペーストするシートの初期化
For i = pasteRow To pasteLastRow Step 1
Worksheets(pasteSheetName).Rows(pasteRow).Delete
Next
 
'コピー開始行から終了行までループ
For i = copyStartRow To copyLastRow Step 1
'数量の指定が不正な場合は次の行へ
If Cells(i, quantityCol).Formula = "" Or IsNumeric(Cells(i, quantityCol).Value) = False Or Cells(i, quantityCol).Value < 1 Then
GoTo Continue
Else
End If
 
'対象行の数量を取得
Dim quantity As Integer: quantity = Cells(i, quantityCol).Value
 
'数量分コピー&ペーストを行う
For j = pasteRow To pasteRow + quantity - 1 Step 1
Range(Cells(i, copyStartCol), Cells(i, copyLastCol)).Copy Destination:=Worksheets(pasteSheetName).Cells(j, pasteCol)
Next
 
'次回ペースト行の更新
pasteRow = pasteRow + quantity
 
'数量の値を初期化
Cells(i, quantityCol).Value = ""
Continue:
Next
 
'ペーストしたシートを選択
Worksheets(pasteSheetName).Select
Worksheets(pasteSheetName).Cells(1, 1).Select
End Sub