🎄teratailクリスマスプレゼントキャンペーン2024🎄』開催中!

\teratail特別グッズやAmazonギフトカード最大2,000円分が当たる!/

詳細はこちら
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

4439閲覧

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

yuko-para

総合スコア5

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2019/12/18 14:08

編集2019/12/18 20:47

前提・実現したいこと

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

Next

End Sub

試したこと

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

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

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

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

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

ワークブックのオープンメソッド(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

総合スコア17000

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

yuko-para

2019/12/19 11:14

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

0

ベストアンサー

ワークブックのオープンメソッド(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

投稿2019/12/19 00:18

編集2019/12/19 02:16
hatena19

総合スコア34073

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

yuko-para

2019/12/19 11:15

返信が遅くなり、申し訳ありません。修正して頂いたコードで試したら上手くいきました! 本当に感謝いたします...また、自分が色々と不勉強だなと思い知りました。 精進していきたいと思います。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.36%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問