Excel マクロファイルと同じシート名の特定の場所にデータを貼付けしたいです。ご教示ください。

Question

集計ファイルに複数のExcelシートがあり、それらのシート名は、
集計ファイルと同じフォルダ内にある複数のデータファイルと同じ名前です。
つまり、
あるフォルダ内のファイル→集計.xlsx、a1.xlsx、b3.xlsx、c5.xlsx
集計.xlsx内のシート名→a1、b3、c5
となっています。
データファイルは画像①、集計ファイルは画像の②のようになっています。
データファイルのＢ2～Ｂ7のデータを、
集計ファイルの内のデータファイルと同じシート名のD2～Ｄ7へコピペする
マクロを作成したいのですが、なんともうまくいきません。。。
ご教示頂ければ幸いです。また、不足している点がございましたら、お知らせください。
よろしくお願いいたします。

Qchan1962 · Accepted Answer

＃４　rukaandkaitoさん　すみません。
開いた後、朝の業務などをやっていたので見落として重なってしまいました。
ありがとうございます。

toska05さん
ランチミーティングがペンディングになったので、さっそく作ってみました。
簡単な検証は実行済みです。
使用環境は、以下のマクロを転記マクロ.xlsmに書きます。
集計.xlsxは開いてから実行します。開いていない場合は、通知されます。
データファイル郡は、同じフォルダに入れてください。（データファイルのフォルダ内に集計.xlsx、転記マクロ.xlsmは有っても無くても良いです）
データファイルのフォルダを指定するダイアログが表示されるので、フォルダを選択してOKを押して下さい。
詳細、処理コードの説明は、コード内にコメントを付けましたので参考にしてください。

＊メイン処理部分の変更などについては、＃３を参考にするか、または、別質問が良いと思います。

Sub Sample2()
Dim FSO As Object, f As Variant
Dim BaseNames() As String, FileNames() As String, cnt As Long, i As Long
Dim ThisPach As String, Wks As Worksheet, TargetSht As Worksheet
Dim TargetBk As Workbook, wbk As Workbook, AggBk As Workbook

On Error Resume Next　'未検証の為（検証時外してください。問題ない場合は再設定）
　　'開いているブックに集計.xlsxがあるか探索----
　　For Each wbk In Workbooks
　　　　If wbk.Name = "集計.xlsx" Then
　　　　　　Windows("集計.xlsx").Activate　’終了した時に前にある方が良いと思い
　　　　　　Set AggBk = ActiveWorkbook　'あれば変数にセット
　　　　End If
　　Next
　　If AggBk.Name = "" Then
　　　　MsgBox ("集計.xlsxが開かれていません。開いてからもう一度実行してください。")
　　　　Exit Sub
　　End If
　　'データフォルダを指定----
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.Title = "データファイルの入ったフォルダを選択してください。"
　　　　.InitialFileName = "D:\"　　'初期表示：返信のエラー表示に合わせています。対象がない場合、カレントフォルダになります。
　　　　If .Show = True Then
　　　　　　ThisPach = .SelectedItems(1) & "\"
　　　　Else
　　　　　　Exit Sub
　　　　End If
　　End With
　　'フォルダ内のファイルを配列に----
　　Set FSO = CreateObject("Scripting.FileSystemObject")　'複数ファイルを操作するのでファイルシステムオブジェクトを使用
　　ReDim BaseNames(FSO.GetFolder(ThisPach).Files.Count)　'配列を使用するためファイル数で配列数を設定（シート名用）
　　ReDim FileNames(FSO.GetFolder(ThisPach).Files.Count)　'配列を使用するためファイル数で配列数を設定（Workbooks.Open用）
　　For Each f In FSO.GetFolder(ThisPach).Files　'VBAが実行されているブックと同じ階層（フォルダ）内を順次抽出

If LCase(FSO.GetExtensionName(f.Name)) = "xlsx" Then　'拡張子がxlsxの場合IF文内を実行
　　　　　　If InStr(f.Name, "集計") = 0 Then　　'ファイル名に集計が含まれているファイルを排除する（実行ファイル配列に入れない）
　　　　　　　　cnt = cnt + 1　　'配列用カウンタ
　　　　　　　　BaseNames(cnt) = FSO.GetBaseName(f.Name)　　'ファイルの名前を配列に（シート名に比較に使用）
　　　　　　　　FileNames(cnt) = f.Name　　'拡張子を含む名前を配列に（ファイルを開くために使用）
　　　　　　End If
　　　　End If
　　Next f
　　If cnt = 0 Then
　　　　MsgBox "xlsxファイルはありません", vbExclamation　'フォルダに該当ファイルが無い場合
　　　　Exit Sub
　　Else
　　　　Application.ScreenUpdating = False　　'ファイルなどを開くので画面処理
　　　　Application.DisplayAlerts = False　　'保存などのアラート非表示に
　　　　For i = 1 To cnt
　　　　　　Set TargetBk = Workbooks.Open(ThisPach & "\" & FileNames(i))　'対象を開く
　　　　　　For Each Wks In AggBk.Worksheets
　　　　　　　　If Wks.Name = BaseNames(i) Then　　'集計.xlsxにターゲットのファイル名と同じ名前のシートがあれば
　　　　　　　　　　For Each TargetSht In TargetBk.Worksheets　'ターゲットファイル内のシートを探索
　　　　　　　　　　　　If TargetSht.Name = Wks.Name Then　　'ターゲットにターゲットファイル名と同じ名前のシートがあれば処理を実行
　　'メイン処理
　　'範囲指定、Copyなど必要に応じ変更
　　'現在は参照式（質問にある範囲）
　　'AggBkは集計ブック　TargetBkは開いているデータブック
　　'AggBk.Sheets(Wks.Name).Range("D2:D7").Value = TargetBk.Sheets(Wks.Name).Range("B2:B7").Value　’変更しやすくするため下記に変更
　　　　　　　　　　　　　　AggBk.Sheets(Wks.Name).Cells(2, 4).Resize(6).Value = TargetBk.Sheets(Wks.Name).Cells(2, 2).Resize(6).Value
　　　　　　　　　　　　End If
　　　　　　　　　　Next TargetSht
　　　　　　　　End If
　　　　　　Next Wks
　　　　　　TargetBk.Close True　'開いたデータブックを閉じる
　　　　　　Set TargetBk = Nothing　'念のため解放
　　　　Next i
　　End If
　　Set FSO = Nothing
　　Set AggBk = Nothing　 '上記ともにすぐにEnd Subでメモリ解放されるが習慣的に
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
End Sub

’---まで

いかがでしょう？

rukaandkaito · Answer

なかなか回答が付きませんが、まず確認させていただきたいのは出力先のブックに保存されているシート名は何でしょう？『データファイルと同じシート名』と記載があるのでそれぞれa1.xlsxのa1シート、b3.xlsxのb3シートという事でしょうか？
また、出力する列に関してですが、集計シートのヘッダー（B2：土手）名称を判定するといったことではなく、単純にＢ列をＤ列に転記するという解釈で構いませんか？
最後に、現状どの段階までコーディングされているのかが気になっています。
理由は出力先のブックを開かなければならないため、何らかの方法で別ブックを開く処理が必要ですが、その方法が複数あるため現状を把握出来ればと思います。
FSO(FileSystemObject)やWorkbookメソッドなどなど
特に指定がないのであればこちらで適当なものを選択しますが(笑)
なぜこのような面倒な質問をするかというと、別ブックを操作する場合該当のファイルが存在しない場合にエラー処理を行わないといけないからです。そうしないと処理がエラーで継続できませんからね(-_-;)

一応簡単なコードを記載しておきます
IF Dir("a1.xlsx") <> "" Then
　Workbooks.Open("a1.xlsx")
Else
　MsgBox "対象のファイルが存在しません"
End If

ファイル名の部分を変数に置き換えてシート名と同一のブックを開くだけなのでそれほど難しいことではありません。ただこのままでは現在のブック（集計ファイル）と出力先のブックの操作が困難なため
Workbooks.Open("a1.xlsx")
の部分を
Dim Wb As Workbook
Set Wb = Workbooks.Open("a1.xlsx")
といった形でオブジェクトとして開きましょう
あとは自身のシートも処理前に退避しておくと操作がしやすいと思いますので、こちらはシートオブジェクトとして
Dim Ws As Worksheet
Set Ws = Sheet1
としておくと処理が明確になると思います

Qchan1962 · Answer

こんにちは、
集計ブックに　データブックの名前のシートがありデータブックにはそのデータブックと同じ名前のシートがあり
同じフォルダ内にすべてがあります。
集計ファイルの内のデータファイルと同じシート名のD2～Ｄ7＝データブックのシートＢ2～Ｂ7のデータ
コピペなので書式なども移したいのかもしれませんが、テスト環境を作るのがちょっと面倒に感じたので
参照式で取敢えずVBAを組みました。出来るだけ汎用性を持たせるため、ブック名、シート名を探す形を
とっています。必ずあるなど環境を整備してズバリ実行可能な条件なら、不要なコードを削除して良いです。コメントに簡単な処理内容を付けます。

このコードは、集計ファイルの標準モジュールで実行します。

Option Explicit
Sub Sample()
Dim FSO As Object, f As Variant
Dim BaseNames() As String, FileNames() As String, cnt As Long, i As Long
Dim ThisPach As String, Wks As Worksheet, TargetSht As Worksheet, TargetBk As Workbook
On Error Resume Next　'未検証の為（検証時外してください）
　　ThisPach = ThisWorkbook.Path
　　Set FSO = CreateObject("Scripting.FileSystemObject")　’複数ファイルを操作するのでファイルシステムオブジェクトを使用
　　ReDim BaseNames(FSO.GetFolder(ThisPach).Files.Count)　’配列を使用するためファイル数で配列数を設定
　　ReDim FileNames(FSO.GetFolder(ThisPach).Files.Count)
　　For Each f In FSO.GetFolder(ThisPach).Files　’VBAが実行されているブックと同じ階層（フォルダ）内を順次抽出
　　　　If LCase(FSO.GetExtensionName(f.Name)) = "xlsx" Then　’拡張子がxlsxの場合IF文内を実行
　　　　　　cnt = cnt + 1
　　　　　　BaseNames(cnt) = FSO.GetBaseName(f.Name)　’ファイルの名前を配列に（シート名に比較に使用）
　　　　　　FileNames(cnt) = f.Name　’拡張子を含む名前を配列に（ファイルを開くために使用）
　　　　End If
　　Next f
　　If cnt = 0 Then
　　　　MsgBox "xlsxファイルはありません", vbExclamation　’フォルダに該当ファイルが無い場合
　　　　Exit Sub
　　Else
　　Application.ScreenUpdating = False　’ファイルなどを開くので画面処理
　　Application.DisplayAlerts = False　’保存などのアラート非表示に
　　　　For i = 1 To cnt
　　　　　　Set TargetBk = Workbooks.Open(ThisPach & "\" & FileNames(i))　’対象を開く
　　　　　　ThisWorkbook.Activate　’（集計）ファイル内のシート探索の為
　　　　　　For Each Wks In Worksheets
　　　　　　　　If Wks.Name = BaseNames(i) Then　　'ThisWorkbookにターゲットのファイル名と同じ名前のシートがあれば
　　　　　　　　　　TargetBk.Activate　’データファイル探索の為
　　　　　　　　　　For Each TargetSht In Worksheets
　　　　　　　　　　　　If TargetSht.Name = Wks.Name Then　　'ターゲットにターゲットファイル名と同じ名前のシートがあれば
　　　　　　　　　　　　　'範囲指定、Copyなど必要に応じ変更
　　　　　　　　　　　　　'現在は参照式（質問にある範囲）
　　　　　　　　　　　　　　ThisWorkbook.Activate　　'Closeを踏まえ念のため
　　　　　　　　　　　　　　ThisWorkbook.Sheets(Wks.Name).Range("D2:D7").Value = TargetBk.Sheets(Wks.Name).Range("B2:B7").Value
　　　　　　　　　　　　End If
　　　　　　　　　　Next TargetSht
　　　　　　　　End If
　　　　　　Next Wks
　　　　　　TargetBk.Close True　’開いたデータブックを閉じる
　　　　　　Set TargetBk = Nothing
　　　　Next i
　　End If
　　Set FSO = Nothing
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
End Sub

上手くいかない場合は、On Error Resume Nextをコメントアウトして
デバックしてください。エラーの内容などを示して頂ければと思います。

取敢えず。。未検証ですが、参考まで

Qchan1962 · Answer

#2です。未検証でしたのでちょっと検証してみました。
ま～あ動きますが、、SelectとかActivateは必要なければ使わない方が良いのに
少し恥ずかしいのですが、、ご指摘がある前に訂正しますね。

不要、削除　　　ThisWorkbook.Activate　’（集計）ファイル内のシート探索の為
　下の行を　　　For Each Wks In ThisWorkbook.Worksheets　に変更してください。
同様に
不要、削除　　　TargetBk.Activate　’データファイル探索の為
変更　　　　　　For Each TargetSht In TargetBk.Worksheets

あまり関係ないですが、　ThisWorkbook.Activate　　'Closeを踏まえ念のため
は、End If
　　Set FSO = Nothingの間行へ
こんな感じで、、要らないと言えば要らないけど、、
End If
　　ThisWorkbook.Activate　
　　Set FSO = Nothing

以上、変更したほうが良いところです。すみません。

訂正ついでに　処理部分のあれこれ、書き方例です。

＃１のやり方
ThisWorkbook.Sheets(Wks.Name).Range("D2:D7").Value = TargetBk.Sheets(Wks.Name).Range("B2:B7").Value

範囲を変数などで変更する場合（下記コードは上のコードと同じ範囲、処理（参照式）
ThisWorkbook.Sheets(Wks.Name).Cells(2,4).Resize(6).Value = TargetBk.Sheets(Wks.Name).Cells(2,2).Resize(6).Value

(＝の右辺と左辺は同じセル範囲（相対位置）でなければなりませんので相対する同じ位置の数値に同じ値の変数を代入する事が出来ます。）

Copyの場合（上の処理と同じ結果、正しクリップボードにデータが残るので他に貼り付け可能）
　　TargetBk.Sheets(Wks.Name).Cells(2, 2).Resize(6).Copy
　　ThisWorkbook.Sheets(Wks.Name).Cells(2, 4).PasteSpecial xlPasteValues　’値貼り付け
＊各数値部分は変数（整数型）で設定できます。
Dim i As Long
i=6
TargetBk.Sheets(Wks.Name).Cells(2, 2).Resize(i).Copy

書き方の違い（いずれもシートを明示する必要があります）
例：　.Cells(2, 2).Resize(5).Copy　は .Range("B2:B6).Copy 　と同じ範囲
　　　.Cells(2, 2).Resize(7).Copy　は .Range("B2:B8).Copy　 と同じ範囲

値貼り付けなので引数Destinationに貼り付け先を指定しないので、コピーしたデータはクリップボードに保管されています。
したがって、Application.CutCopyMode = False　などまで、（コピーモードを維持できる間）他の場所にも値の貼り付けが可能です。
　　Application.CutCopyMode = False　コピーモードを解除する。必要に応じて（貼り付けが終わったらなど）

情報が多く分かり難くなってしまったかも知れません。
参考まで

rukaandkaito · Answer

No1です
No2,No3で素晴らしい回答がついていますので、そちらに対してエラーが発生しているという部分で気になった点を横から失礼します
集計ファイルはマクロを含んでいるため拡張子は『xlsx』ではなく『xlsm』ではないでしょうか。
質問者様の返答で『実行時エラー1004　$集計.xlsxを開くことができません。拡張子が正しくありません。』と記載されていますが、実行環境としてNo2の方が仰っているように、集計ファイルにマクロを記載し拡張子『xlsm』で保存することで回避できるのではと思いました

Qchan1962 · Answer

おはようございます。
デバック、ありがとうございます。
先ず、簡単なところから、
＞少し変えてみましたが、別のエラーが出てしまいました。
Set TargetBk = Workbooks.Open(ThisPach & FileNames(i)) '対象を開く
「実行時エラー1004　D\転記a01.xlsxが見つかりません。異動や削除が行われた可能性があります。」
→a01.xlsxは同じフォルダ内（フォルダ名：転記）に存在しています。

これについては、元のコードのままでお願いします。
Set TargetBk = Workbooks.Open(ThisPach & "\" & FileNames(i))

￥は、階層を表します。フォルダとファイル名の間に必要です。

次に
＞Set TargetBk = Workbooks.Open(ThisPach & "\" & FileNames(i))
「実行時エラー1004　$集計.xlsxを開くことができません。拡張子が正しくありません。」
→集計.xlsxはマクロファイル（転記マクロ.xlsm）と共に開いた状態で、集計ファイルの開発タブからマクロを実行しています。

これは、ご質問から推測できる環境ではありませんでしたね。
先に示しましたVBAコードは、集計.xlsxの標準モジュールにマクロを書きマクロ有効ブックとして
集計.xlsm保存して（これは大事、作成時保存せずに実行するとThisWorkbook.Pathが確定しないので）
集計.xlsmと同じ階層（フォルダ）にある.xlsxファイルに対して実行する事を想定しています。

したがって、集計.xlsxを集計.xlsmに変更して集計ファイルにVBAを組めば、実行されると思います。

また、返信にある環境で使用するには、変更が必要になります。

さらに、集計.xlsxを開いていても、閉じていても同じフォルダにあれば実行されるようにも出来ますが
ある程度、条件は絞ったほうが良いと思います。

あと、返信のような環境であれば、a01.xlsxファイル群を同じフォルダに入っていれば

a01.xlsxファイル群、転記マクロ.xlsm、集計.xlsxが共に同じフォルダでなくても実行できるように出来ます。
ただし、処理工程が増えて処理時間がかかったり、UI（ユーザーインタフェイス）ダイアログなどでユーザーが対応する事になります。

ThisWorkbook.Sheets(Wks.Name).Cells(2,4).Resize(6).Value = TargetBk.Sheets(Wks.Name).Cells(2,2).Resize(6).Value
目的の処理は、シンプルなので　使用環境をある程度限定してしまった方が良いかと思います。もちろん、エラー処理を加えて。

返信の環境に合わせたもので良ければ、午後の空き時間（15時頃かな？）に作ってみますね。検証環境は作れないかも知れませんが、、
もし時間が作れなかったら、、帰宅後になりますが、、
できれば、希望の仕様（動作環境）があれば、お知らせください。
ほとんど、作成受けの様になってしまいましたが、、
＞ひとつひとつ本とにらめっこして勉強させていただいております。
と言う事と、ずらずらコードを書いた責任をと思いますので。

Excel マクロ ファイルと同じシート名の特定の場所にデータを貼付けしたいです。ご教示ください。

こんにちは、

#2です。

No1です

おはようございます。

＃４ rukaandkaitoさん すみません。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

Excel マクロファイルと同じシート名の特定の場所にデータを貼付けしたいです。ご教示ください。

＃４　rukaandkaitoさん　すみません。