Excel VBA 任意で選択したセル範囲の内容を別なワークブックにコピー転記できるようにしたい。

前提・実現したいこと

Excel VBA の初心者です。
ワークブック(.xlsm)内の選択した任意のセル範囲(範囲は固定でなく自由)の内容を、別なワークブック(.xlsx)の指定したワークシートへコピー転記できるようなマクロを組みたいです。
また、別なワークシートへ転記の際に、既に書かれているセルの続きから転記されるようにしたいです。

どうすれば改善されるか、アドバイスなどご教授頂ければと思います。
不慣れで申し訳ありませんが、どうぞよろしくお願いいたします。

発生している問題・エラーメッセージ

テストマクロを作って試してみたのですが、
下記のような状態になってしまい、カーソルで選択した範囲全てを転記できません。

該当のソースコード

Excel VBA

Sub データ転記()

Dim fl As Variant
Dim wb As Workbook
Dim wsDst As Worksheet
Dim i As Long

Dim myRange As Range
Dim rw As Long

i = 2

For Each myRange In Selection

fl = Application.GetOpenFilename
Set wb = Workbooks.Open(Filename:=fl)
Set wsDst = wb.Worksheets("転記先")

rw = wsDst.Cells(Rows.Count, i).End(xlUp).Row + 1
  
wsDst.Cells(rw, i).Value = myRange.Value

i = i + 1

End Sub

試したこと

ワークブックのオープンメソッド(Application.GetOpenFilename)を、For Each ...Nextステートメントの外に出すと、マクロを実行しても何も転記されず変わりません。

補足情報（FW/ツールのバージョンなど）

このテストマクロを作ったエクセルは2010のものですが、実際は2010以降の新しいバージョンのエクセルで作る予定です。

行動規範の内容に同意します

回答2件

他の回答と似た内容になってしまいますが、転記するだけでよいならループで回す必要はないです。

ワークブックのオープンメソッド(Application.GetOpenFilename)を、For Each ...Nextステートメントの外に出すと、マクロを実行しても何も転記されず変わりません。

恐らく別のワークブックを開くことでSelection状態が認識されていないのではと思います。
これを回避するために以下のサンプルでは事前に配列に保持しておき、それをコピーするようにしています。

VBA
1Sub データ転記()
2    
3    Dim fl As Variant
4    Dim wb As Workbook
5    Dim wsDst As Worksheet
6    Dim rw As Long
7    Dim src As Variant
8    
9    src = Selection
10    
11    fl = Application.GetOpenFilename
12    Set wb = Workbooks.Open(Filename:=fl)
13    Set wsDst = wb.Worksheets("転記先")
14    
15    rw = wsDst.Cells(wsDst.Rows.Count, 2).End(xlUp).Row + 1
16    wsDst.Cells(rw, 2).Resize(UBound(src, 1), UBound(src, 2)) = src
17    
18End Sub
19

投稿2019/12/19 00:45

ttyp03

総合スコア16998

yuko-para

2019/12/19 11:14

返信が遅くなり、申し訳ありません。修正して頂いたコードで試したら上手くいきました! コードの中で自分がまだ知らなかったメソッド(?)→Resize ,UBound　があり、今後の勉強として学ばせていただきました。本当にありがとうございます。

行動規範の内容に同意します

ベストアンサー

ワークブックのオープンメソッド(Application.GetOpenFilename)を、For Each ...Nextステートメントの外に出すと、

そうしないと、ループの回数分（セル一つ毎）にファイル選択ダイアログが開くことになります。
~~何も実行されないなら記述かどこか間違っているのでしょう。~~
他の方の回答で指摘されてますが、別ブックを開くことで Selection が変わっているのが原因ですね。

ちなみに、コピー元とペースト先のセル範囲のサイズが同じならループさせる必要はないです。

vba
1Sub データ転記()
2
3    Dim fl As Variant
4    Dim wb As Workbook
5    Dim wsDst As Worksheet
6    Dim i As Long
7    
8    Dim myRange As Range
9    Dim rw As Long
10    Set myRange = Selection '別ブックを開く前に選択範囲を格納しておく
11    i = 2
12    fl = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
13    Set wb = Workbooks.Open(Filename:=fl)
14    Set wsDst = wb.Worksheets("転記先")
15    rw = wsDst.Cells(Rows.Count, i).End(xlUp).Row + 1
16
17    With myRange 
18        wsDst.Cells(rw, i).Resize(.Rows.Count, .Columns.Count).Value = .Value
19    End With
20 
21End Sub