すぐマク　YNxv9982 Home | Search | Contents | Gallery | Introduction | Service | Support | What's New!
指定されたデータを指定された回数ずつ他のシートにコピーして印刷するには？
Ｑuestion 59.1　コピー Previous Next
Sheet2 Sheet1 私はまったくの素人でありがなら、自分でしたいことを 500連発 第2弾を参考に勉強させてもらっていますが、

どうしても記述の方法がわからないので助けていただきたく、メールさせてもらいました。

Sheet1（上左図）のように A列に文字列、B列に個数が入力されています。
それに基づいて Sheet2（上右図）に並べて、入力された範囲のみを印刷したいのですが、お教えいただけないでしょうか？
Ａnswer　　 Copyright (C) 2003.3.31 Yoshioh Nagai
詳細は こちら 500連発 第2弾をご愛読、ありがとうございます。
このテーマはいくつかの要素を含んでいます。「どうしても記述の方法がわからない」のは、どこなのかが不明ですが勉強中とのことですので、第1歩からご説明します。

Sheet2のデザインが複雑ですね。A2セルから順次下方向へ A8セルまで貼り付けて行き、その次は B2セルから B8セルまで、次はページ2の A11セルへ飛びます。ページ1 と 2は同じデザインに見えますが、ページ1は 7行、ページ2は 6行で構成されています。
そのため、このように複雑な表を作成しようとすると、どんなマクロを作成すればよいのか、つい考えあぐねてしまいますね。

しかし、作業用シート（例えば Sheet3）を設けて単純に、A列の上から下へ順に貼り付けするだけのマクロなら、そんなにややこしくはなりません。
そして、そのシートができあがったら Sheet2へ下表のとおりコピーするだけです。
コピー元 （Sheet3） コピー先 （Sheet2）
A1:A7 A2:A8
A8:A14 B2:B8
A15:A20 A11:A16
A21:A26 B11:B16
このマクロは自動記録で簡単に作成できますから、してみてください。なお、下記のマクロは自動記録後に、余分なコードを削除してあります。 
Sub 作業用シートからSheet2へコピー貼り付けする()
    Sheets("Sheet3").Range("A1:A7").Copy
    Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteValues
    Sheets("Sheet3").Range("A8:A14").Copy
    Sheets("Sheet2").Range("B2").PasteSpecial Paste:=xlPasteValues
    Sheets("Sheet3").Range("A15:A20").Copy
    Sheets("Sheet2").Range("A11").PasteSpecial Paste:=xlPasteValues
    Sheets("Sheet3").Range("A21:A26").Copy
    Sheets("Sheet2").Range("B11").PasteSpecial Paste:=xlPasteValues
End Sub
このようにしてSheet2ができる前提で、「ページ1」と「ページ2」を無条件で印刷するマクロを自動記録しておきます。下記マクロは自動記録後に行番号とコメントを追加しました。 
private Sub Macro1()
10  Sheets("Sheet2").Select                     'シート2を選択する
20  Range("A2:B8").Select                       'A2:A8セル範囲を選択する
30  ActiveSheet.PageSetup.PrintArea = "$A$2:$B$8" ''A2:A8セル範囲を印刷範囲として設定する
40  ActiveWindow.SelectedSheets.PrintOut Copies:=1 '印刷する
50  Range("A11:B16").Select
60  ActiveSheet.PageSetup.PrintArea = "$A$11:$B$16"
70  ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub
上記 Macro1 を 「入力された範囲のみを印刷」するように改造します。具体的には、A1セルの値が""（長さゼロの文字列）でなければ「ページ1」を印刷し、さらに、A11セルの値が同様ならば「ページ2」を印刷します。
下記マクロは自動記録された余分なコードを削除してから、25、45、55、75行目に If文を追加してあります。 
Sub Sheet2で印刷範囲を設定して印刷する()
10  Sheets("Sheet2").Select
25  If Range("A1").Value <> "" Then             'A1セルの値が""でなければ
30      ActiveSheet.PageSetup.PrintArea = "$A$2:$B$8"
40      ActiveWindow.SelectedSheets.PrintOut Copies:=1
45  End If
55  If Range("A11").Value <> "" Then             'A11セルの値が""なければ
60      ActiveSheet.PageSetup.PrintArea = "$A$11:$B$16"
70      ActiveWindow.SelectedSheets.PrintOut Copies:=1
75  End If
End Sub
次に、マクロの心臓部を、次の要領で作成します。

1. Sheet1から作業用シートへ コピーするコード
詳細は こちら このコードは自動記録でも簡単に作成できますし、500連発第2弾にもいろいろ掲載されています。
しかし、ここでは、500連発（第1弾）316番の「クリップボードを経由せずにコピーして全て貼り付ける」方法が適当でしょう。 第1弾をお持ちでない場合は、このHPのMacroのページの「クリップボードを経由せずにコピー貼り付けする_同一ブック」をご活用ください。

例えば、Sheet1のA2セルから、作業用シートのA1セルへコピーするコードは次のとおりになります。 
    Worksheets("Sheet1").Range("A2").Copy Destination:=Worksheets("Sheet3").Range("A1")
上記のコードのコピー元とコピー先の行番号を変えれるように、下記のとおり改造しておきます。 
Private Sub Macro2()
10  Worksheets("Sheet1").Activate               'Sheet1をアクティブにする
20  コピー元行 = 2
30  コピー先行 = 1
40  コピー元セル = "A" & コピー元行
50  コピー先セル = "A" & コピー先行
60  Worksheets("Sheet1").Range(コピー元セル).Copy _
    Destination:=Worksheets("Sheet3").Range(コピー先セル)
End Sub
2. データの下端行を取得するコード
Sheet1のA列の「寸法」データの下端行を取得します。このHPの「アクティブセル領域の行列数を調べる」を活用して下記のとおりとします。なお、500連発にもいろいろな方法が紹介されていますから、必要により参照してください。 
Private Sub データの下端行を取得する()
10  Worksheets("Sheet1").Activate               'Sheet1をアクティブにする
15  下端行 = Range("A1").CurrentRegion.Rows.Count 'アクティブセル領域の行数を取得する
End Sub
3. B列が示す回数分ずつA列を作業用シートにコピーするマクロ
繰り返し処理が2カ所あります。
　　(1) 小さい繰り返し ・・・ 各寸法ごとに B列の個数に対応する回数だけ繰り返してコピーする
　　(2) 大きい繰り返し ・・・ Sheet1の 2行目から1行ずつ処理し、下端行に達するまで繰り返す
どちらの処理にも For...Next文を使用することにします。 500連発（第1弾）では463番が参考になります。

(1)小さい繰り返し のマクロを作成します。下記のとおり Macro2に 35、37、65、67行目を追加すれば出来上がります。
 
Private Sub Macro3()
10  Worksheets("Sheet1").Activate               'Sheet1をアクティブにする
20  コピー元行 = 2
30  コピー先行 = 1
35  個数 = Cells(コピー元行, 2).Value           '個数を取得する
37  For 回数 = 1 To 個数
40      コピー元セル = "A" & コピー元行
50      コピー先セル = "A" & コピー先行
60      Worksheets("Sheet1").Range(コピー元セル).Copy _
        Destination:=Worksheets("Sheet3").Range(コピー先セル)
65      コピー先行 = コピー先行 + 1
67  Next
End Sub
(2) 大きい繰り返し のコードを Macro3に追加します。下記の For...Next文（15、32、69行目）です。 
'-----------------------------------------------------------------------------------------
Sub Sheet1の2行目から下端行までB列が示す回数分ずつA列を作業用シートにコピーする()
10  Worksheets("Sheet1").Activate               'Sheet1をアクティブにする
15  下端行 = Range("A1").CurrentRegion.Rows.Count 'アクティブセル領域の行数を取得する
20  コピー元行 = 2
30  コピー先行 = 1
32  For コピー元行 = 2 To 下端行
35      個数 = Cells(コピー元行, 2).Value               '個数を取得する
37      For 回数 = 1 To 個数
40          コピー元セル = "A" & コピー元行
50          コピー先セル = "A" & コピー先行
60          Worksheets("Sheet1").Range(コピー元セル).Copy _
            Destination:=Worksheets("Sheet3").Range(コピー先セル)
65         コピー先行 = コピー先行 + 1
67      Next
69  Next
End Sub
'-----------------------------------------------------------------------------------------
4. 個々に作成したマクロを連続実行するマクロ
上記3.で仕上げておいたマクロと先に仮作成しておいたマクロを、順に実行するマクロを下記のとおり作成します。なお、そのマクロの最初に 作業用シートをすべてクリアするコードを入れておきます。 
Sub 指定されたデータを指定された回数ずつ他のシートにコピーして印刷する()
    Sheets("Sheet3").Select
        Cells.Clear                             'すべてクリアする
    Sheet1の2行目から下端行までB列が示す回数分ずつA列を作業用シートにコピーする
    作業用シートからSheet2へコピー貼り付けする
    Sheet2で印刷範囲を設定して印刷する
End Sub
［マクロの登録］ダイアログ 5. ボタンにマクロを登録する
Sheet1にあるボタンは［フォーム］ツールバーの［ボタン］ですから、それを右クリックし、表示されたショートカットメニューの［マクロの登録］をクリックし、左図のとおり［マクロ名］を選択して［登録］ボタンをクリックします。
左図では見えませんが［マクロの保存先］には［作業中のブック］を選択します。

なお、ボタンの選択状態を解除するには、Sheet1の適宜のセル（例えばA1）を選択します。
サンプルブックのダウンロードは ここをクリック 　（YNxv9982_CopyDestination.xls　48KB）
※ 一旦、ブックをハードディスクに保存し、後で改めて開いてから実行してください。
http://www.happy500z.com/ Home | Contents | Gallery | Introduction | Service | Support | What's New!