増減するデータをコピー貼り付けした次の行に他のデータをコピー貼り付けするには?
Question 99.2 Excel VBA Borad (掲示板)より Previous Next
初めて質問させて頂くので色々御迷惑をお掛けしますが、よろしくお願いします。

例としまして、
AのシートのA1~終わりまでデータが無くなるまでBのシートに貼り付け、
次にC1~C10あたりまでBのシートの貼り付けた後に貼り付けたいのです。

実は、知人から頂いたマクロを見たことがありますが、実際の所、私は素人ですので、よく分かっておりません。
申し訳ありませんが、宜しくお願い致します。
Answer   Copyright (C) 2009.12.25 永井善王
コピー貼り付けのマクロですね。
いっぺんに全部作ろうとすると、あれこれ悩んでしまうでしょうから、 まず最初は右図のとおりに、コピー貼り付けするマクロを作ってみましょう。
 (図をクリックすると拡大できますから、それを見て新しいブックに、データ の入ったAのシートと、何も入ってないBのシートを作成し、任意の名前を 付けて保存しておいてください。
シート名の「A」「B」は、ここでは全角英数を使っています。)

マクロ作成の操作手順
 1.マクロ記録を開始する
 2. Bのシートを選択し、すべてのセルを選択して、すべてクリア
 3. Aのシートを選択し、セル範囲 A1:A7 を選択して、コピー
 4. Bのシートを選択し、A1セルを選択して、貼り付ける
 5. Aのシートを選択し、セル範囲 C1:C10 を選択して、コピー
 6. Bのシートを選択し、A8セルを選択して、貼り付ける
 7. マクロ記録を終了する

すると下記のようなマクロができているはずです。 (冒頭にできるコメント行は削除してある)
Sub Macro1()
    Sheets("B").Select
    Cells.Select
    Selection.Clear
    Sheets("A").Select
    Range("A1:A7").Select
    Selection.Copy
    Sheets("B").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("A").Select
    Range("C1:C10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("B").Select
    Range("A8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
記録してできたマクロは冗長で見にくいので、下記のとおり整理しておきましょう。 (赤字は後で修正するところです。)
Sub Macro1()
    Sheets("B").Select
        Cells.Clear
    Sheets("A").Select
        Range("A1:A7").Copy
    Sheets("B").Select
        Range("A1").PasteSpecial Paste:=xlPasteValues
    Sheets("A").Select
        Range("C1:C10").Copy
    Sheets("B").Select
        Range("A8").PasteSpecial Paste:=xlPasteValues
End Sub
マクロコード整理のポイント
 1. マクロの冒頭にできる分かりきったコメントを削除する
 2. 適当にインデント(字下げ)する
 3. 機能の区切りに空行を作る
 4. 不要なコードを削除する
 5. 省略可能な引数を削除する
 6. 適当に説明文を入れる
これらについての解説は、ここでは割愛します。 くわしく知りたい場合は拙著 作りながら覚える! Excel VBA マクロ組み方講座 の52~55ページを参照してください。 蔵書している図書館もあるようです。

マクロの修正
Aのシートからコピーするセル範囲が A1:A7 になっています。これを 『A1~終わりまで』 にしなければなりませんから、上から5行目のコードを下記のとおりの2行に修正します。
        下端行 = Range("A" & Rows.Count).End(xlUp).Row
        Range("A1:A" & 下端行).Copy
Rows.Count
はワークシートの最下行、つまり、Excel2003以前なら65536を意味します。 そこから End(xlUp) するということは上方向に領域の終端セルを探して、Row 、つまり、行番号を返してくれますから、図の場合なら 7 となります。
上から9行目のコピー範囲も、同様にして修正してください。

【参考】 Endプロパティ
  Range("A" & Rows.Count).End(xlUp).Row
  ①    ⑪  ⑫ ⑬   ⑭    ②  ⑮   ③
①次の( )内で示すセル ②次の( )内で示す方向の領域の終端セルの ③行番号
⑪A列 ⑫の ⑬行の ⑭総数 ⑮上方向

一方、貼り付けるセルを指定するコードは、上から7行目は修正なしですが、下から2行目は修正が必要です。考え方は同じですから、ご自分で修正してみてください。
でき上がったマクロは下記のようになります。
Sub Macro1_修正後()
    Sheets("B").Select
        Cells.Clear
    Sheets("A").Select
        下端行 = Range("A" & Rows.Count).End(xlUp).Row
        Range("A1:A" & 下端行).Copy
    Sheets("B").Select
        Range("A1").PasteSpecial Paste:=xlPasteValues
    Sheets("A").Select
        下端行 = Range("A" & Rows.Count).End(xlUp).Row
        Range("C1:C" & 下端行).Copy
    Sheets("B").Select
        下端行 = Range("A" & Rows.Count).End(xlUp).Row
        Range("A" & 下端行).PasteSpecial Paste:=xlPasteValues
End Sub
では、上手くいくようになったらご連絡ください。

Excel VBA Macro