商品ラベルアーカイブ

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

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

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

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

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

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 &lt; 1 Then
GoTo Continue
Else
End If

'対象行の数量を取得
Dim quantity As Integer: quantity = Cells(i, quantityCol).Value

'数量分コピー&amp;ペーストを行う
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

タグ: 商品ラベル

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