質問をすることでしか得られない、回答やアドバイスがある。

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

新規登録して質問してみよう
ただいま回答率
85.50%
Windows 10

Windows 10は、マイクロソフト社がリリースしたOSです。Modern UIを標準画面にした8.1から、10では再びデスクトップ主体に戻され、UIも変更されています。PCやスマホ、タブレットなど様々なデバイスに幅広く対応していることが特徴です。

VBA

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

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

関数

関数(ファンクション・メソッド・サブルーチンとも呼ばれる)は、はプログラムのコードの一部であり、ある特定のタスクを処理するように設計されたものです。

Q&A

解決済

1回答

7163閲覧

ブック間のコピー(2カ所)をしたいです

kogukoguT

総合スコア1

Windows 10

Windows 10は、マイクロソフト社がリリースしたOSです。Modern UIを標準画面にした8.1から、10では再びデスクトップ主体に戻され、UIも変更されています。PCやスマホ、タブレットなど様々なデバイスに幅広く対応していることが特徴です。

VBA

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

コピー

元のオブジェクトを破壊することなく、オブジェクトの複製を生成することをコピーと呼びます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

関数

関数(ファンクション・メソッド・サブルーチンとも呼ばれる)は、はプログラムのコードの一部であり、ある特定のタスクを処理するように設計されたものです。

0グッド

0クリップ

投稿2020/05/22 13:22

ブック間のコピー(2カ所)をしたいです。

マクロ初心者です。複数ある申込書を一つのデータにまとめるのに転記作業に時間がかかっているため
仕事の量を軽減するために始めたものの行き詰ってしまい、
調べてもどこが原因かわからず2日くらい悩んでいます。

ネットで「複数フォルダ 転記 マクロ」で検索してでてきたVBAを参考に作成しています。
失礼な聞き方と存じますが助けていただけますでしょうか。

コピー元から二カ所コピーし、コピー先のブックに二カ所ペーストをしたいです。
一カ所のコピーはできたのですが、もう一つができなく困っています。

下記4つをやろうとしています。

(1)コピー元は同じフォーマットで複数存在し、コピー先と同じフォルダに入っています
(2)コピー元がなくなるまでコピー先の空白の行に繰り返し転記
(3)1つ目のコピー(copy1とします)はCOUNTA関数で数えたセルの数(copy2の数です)だけコピー先に転記する
(4)1つ目のコピー、2つ目のコピー(copy2とします)ともに空白の行に転記する

このうちcopy2の転記はできたのですが、copy1の転記ができません。

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

2つ目のコピーはクリップボードを宣言してからやったところ
うまくできたのですが、1つ目のコピーがうまくいかず、

エラー9「インデックスが有効範囲にありません」

とでてしまいます。

該当のソースコード

Dim OpenExcelFileName, ExcelFileName, ExcelFilePath, FileName As String Dim i As Long 'ダイアログを表示取り込むフォルダーにあるファイルを選択します。 OpenExcelFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") '指定したファイルパスからファイル名を代入します。        '指定したファイルパスを指定します。(ファイルパスからファイル名を取り除く) If OpenExcelFileName <> "False" Then ExcelFileName = Dir(OpenExcelFileName) ExcelFilePath = Replace(OpenExcelFileName, ExcelFileName, "") MsgBox ExcelFilePath & "この選択フォルダからデータを読込み込みます。" Else MsgBox "キャンセルされました"          'キャンセルでプログラムを終了します。  Exit Sub End If '指定したフォルダーから一件目のEXCELファイルを指定します。 FileName = Dir(ExcelFilePath & "*.xls?") 'カレントフォルダに存在するExcelファイルを全て読み込む Do While FileName <> "" Workbooks.Open FileName:=ExcelFilePath & FileName, ReadOnly:=True, UpdateLinks:=0 i = 1 'ここから下をコピペ作業 'copy1のコピー 'copy2の数だけコピペする Dim num As Integer num = WorksheetFunction.CountA(Sheets("コピー元").Range("b10:b12")) For j = 1 To num Dim last_row As Long last_row = Sheets("コピー先").Cells(Rows.Count, 2).End(xlUp).Row '→ここでエラー9がでます。 Sheets("コピー元").Range("H5:M5") = Sheets("コピー先").Cells(last_row + j, 2) Next j 'copy2のコピー Dim clipboard clipboard = Sheets("コピー元").Range("B10:M13") ActiveWindow.Close '空白のセルまで移動して、そこに転記 Dim last_row1 As Long last_row1 = Sheets("コピー先").Cells(Rows.Count, 7).End(xlUp).Row Cells(last_row1 + 1, 7).Select Sheets("コピー先").Range(Cells(last_row1 + 1, 7), Cells(last_row1 + 4, 18)) = clipboard '次のExcelファイルを取得    FileName = Dir() '行数をカウント     i = i + 1 Loop End Sub

試したこと

ここに問題に対して試したことを記載してください。

Dim copy1 as String
Sheets("コピー元").Range("H5:M5") = copy1
num = WorksheetFunction.CountA(Sheets("コピー元").Range("b10:b12"))
For j = 1 To num
Dim last_row As Long
last_row = Sheets("コピー先").Cells(Rows.Count, 2).End(xlUp).Row
Sheets("コピー先").Cells(last_row + j, 2) = copy1

でもやってみましたが、
’ last_row = Sheets("コピー先").Cells(Rows.Count, 2).End(xlUp).Row’
で同じくエラー9になってしまいます。

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

windows10, Office365使用です

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

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

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

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

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

meg_

2020/05/22 16:22

エラーが出る行の前に「Sheets("コピー先").Activate」を入れたらどうなりますか?
kogukoguT

2020/05/23 00:29

添削してくださり誠にありがとうございます。 ご提示くださったように入れてみましたが、「Sheets("コピー先”).Activate」でエラーが発生してしまいました。 そこでhatena19様の回答にmeg_様のご提案を組み合わせたところ、うまく転記がいくようになりました。 お知恵をかしてくださりありがとうございました! おかげさまで2時間かかってた仕事が1分せず終わりました。
guest

回答1

0

ベストアンサー

コピー元のシートとコピー先のシートは別ブックということですよね。

ブックを明示的に指定しないと、アクティブブックが対象になります。
Workbooks.Openすると開いたブック(コピー元のブック)がアクティブになります。

vba

1last_row = Sheets("コピー先").Cells(Rows.Count, 2).End(xlUp).Row

はコピー元のブックが対象になりますが、コピー元ブックには、コピー先シートはないはずですので当然エラーになります。
アクティブブック前提のコードはやめて、ブックを明示的に指定するコードに変更しましょう。

vba

1'前略 2 3'コピー先ブックを変数に格納 4Dim wbTo As Workbook 5Set wbTo = ThisWorkbook 6 7'カレントフォルダに存在するExcelファイルを全て読み込む 8Do While FileName <> "" 9 'コピー元ブックを開いて変数に格納 10 Dim wbFrom As Workbook 11 Set wbFrom = Workbooks.Open(FileName:=ExcelFilePath & FileName, ReadOnly:=True, UpdateLinks:=0) 12 13i = 1 14 15 'ここから下をコピペ作業 16 17 'copy1のコピー 18 'copy2の数だけコピペする 19 Dim num As Integer 20 num = WorksheetFunction.CountA(wbFrom.Sheets("コピー元").Range("B10:B12")) 21 For j = 1 To num 22 Dim last_row As Long 23 last_row = wbTo.Sheets("コピー先").Cells(Rows.Count, 2).End(xlUp).Row 'ここのエラーはなくなるはず 24 25 '↓このコードはおかしいので要修正 26 Sheets("コピー元").Range("H5:M5") = Sheets("コピー先").Cells(last_row + j, 2) 27 28 Next j 29 30 31'以下同様に、対象ブックを省略せずに記述するように変更

投稿2020/05/22 18:32

hatena19

総合スコア33620

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

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

kogukoguT

2020/05/23 00:44

添削してくださり誠にありがとうございます。 おっしゃる通り別のブックがコピー先になります。 ブックを指定しないといけないとは全く考えにもありませんでした。 コピペでマクロをしている者に優しくコードを書き直してくださり本当に助かります。 コピペのやり方が良くなかったのか、頂いたコードでも同じところでデバックしてしまったのですが、 ・デバックする手前に「wbTo. Activate」を入れる ・「=」で転記をするのではなく、「.Copy と.PasteSpecial」で転記する ようにしたらうまく動きました・・・!!! 'copy1のコピー 'copy2の数だけコピペする wbFrom. Activate Dim num As Integer num = WorksheetFunction.CountA(wbFrom.Sheets("コピー元").Range("B10:B12")) For j = 1 To num wbFrom. Sheets("コピー元”). Range("H5:M5"). Copy wbTo. Activate last_row = wbTo.Sheets("コピー先").Cells(Rows.Count,2).End(xlUp).Row wbTo.Sheets("コピー先”).Range(Cells(last_row + j, 2), Cells(last_row + j, 7)).PasteSpecial xlPasteValues Application.CutCopyMode = False この2週間スタックしていたのが嘘のようで、文字通り小躍りしてしまいました。 お知恵を貸してくださり本当にありがとうございました。 プロの方に勇気を出して質問してよかったです。 なぜか繰り返し転記が「繰り返しの数*1行」空いて転記になっていましたが、最後に空白の行を削除することで完成いたしました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問