選択したシートのデータをコピーし別のブックのシートの末尾に貼り付けるには?
Question 80.6   Previous Next
  A     B    C   D
1 2003年 6月  1日  晴れ
2 2003年 6月  2日  曇り
3 2003年 6月  3日  雨

上記のbook1のsheet1を貼り付けたい文字列とします。
book1のsheet1から、book2のsheet1へ貼り付けたいのですが、貼り付けたい文字列(タイトルは貼り付けません)は、常に決まった行数ではなく一定していません。列数は常に同じです。
book2に複数の文字列を貼り付けたいです(貼り付けたらその貼り付けた最後の列のすぐ次の列に)。例えば3行目まで貼り付けたら、4行目からまた貼り付けたいのです。
そして、book1のファイル名は毎回変わります。book2のファイル名は常に一緒です。 book1のタイトルが変わってもbook2に貼り付けれるマクロを教えてください。
Answer   Copyright (C) 2003.6.24 永井善王
「book1のsheet1の行数は一定ではない」と言うことですから、まず、(クリップボード)へコピーする方法から考えてみましょう。
このHPの中の「Macro・コピー」のページでいろいろな方法が紹介されています。その中に「
使われたセル範囲をコピーして別のシートに貼り付ける」というマクロがありますから、参考にして下記のように改造してみましょう。
    Worksheets("Sheet1").UsedRange.Copy
    ActiveSheet.Paste Destination:=Workbooks("book2.xls"). _
        Worksheets("Sheet1").Range("A1")
1行目のコードでコピーして、2行目のコードで貼り付けていることを分かりますね。

2行目のコードは A1セルに貼り付けていますので、これを「貼り付けた列のすぐ次の列に貼り付ける」ように改造するには、どうすればよいでしょうか。 「Macro・範囲選択」のページにある「
アクティブセル領域の行列数を調べる」というマクロを参考にして、下記のように組みましょう。
なお、タイトル(列)は book1にはなく、book2だけにあるようなので、こんなに簡単なコードで済みます。
    Workbooks("book2.xls").Worksheets("Sheet1").Activate
    行 = Range("A1").CurrentRegion.Rows.Count + 1
    ActiveSheet.Paste _
    Destination:=Workbooks("book2.xls").Worksheets("Sheet1").Range("A" & 行)
「book1のファイル名は毎回変わります」ですが、「Macro・メッセージ」のページにある「組み込みダイアログボックスの活用」の中にある「ファイルを開く」を使うことにしましょう。
    Application.Dialogs(xlDialogOpen).Show
以上を組み合わせて仕上げると、下記のようになります。 このマクロは book2のモジュールシートに作成します。
'------------------------------------------------------------------------------
Sub 選択したブックのシートのデータをコピーして別のブックのシートの末尾に貼り付ける()
    Application.Dialogs(xlDialogOpen).Show      '[ファイルを開く]ダイアログを表示
    Worksheets("Sheet1").UsedRange.Copy         '使われたセル範囲をコピーする
    Workbooks("book2.xls").Worksheets("Sheet1").Activate 'book2のSheet1
    行 = Range("A1").CurrentRegion.Rows.Count + 1 'アクティブセル領域の行数 + 1
    ActiveSheet.Paste _
    Destination:=Workbooks("book2.xls").Worksheets("Sheet1").Range("A" & 行)
End Sub
'------------------------------------------------------------------------------

 

Excel VBA Macro