転記先VBA 一致しているセルがコピーされない

以下のVBAでセルのコピーまではいけたのですが、アクティブシートのセルがコピーされます。また、転記先に貼り付けがされません。一致したシートをアクティブにし、そのシートのセル内容を転記先にコピーしたいです。ご教授頂けると幸いです。
よろしくお願いいたします。

Option Explicit

Sub マスターデータ取り込み02() '選択したファイルを取り込み、別のファイルに貼り付ける

Dim RC As Integer
Dim OpenFileName, fileName, Path, SetFile As String
Dim wbMoto, wbSaki As Workbook
Dim sh1name As String
Dim i As Long
Dim flag As Boolean

sh1name = ActiveSheet.Name '現在開いているシート名

Set wbMoto = ActiveWorkbook 'マスターデータ取り込み元をセット

Application.DisplayAlerts = False '応答メッセージの非表示

RC = MsgBox("Excel Bを開きますか?", vbYesNo + vbQuestion, "確認")
If RC = vbYes Then 'もしRCのメッセージにYesと答えたら

OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
'ダイアログボックスを表示して、マスターデータファイルを指定します。

If OpenFileName <> "Fales" Then 'もし指定したファイルがFalseではなかったら
SetFile = OpenFileName 'マスターデータファイルの指定=SetFile
Else '指定したファイルがなかったら
MsgBox "キャンセルされました" 'キャンセルされましたというメッセージボックスが表示される
Exit Sub 'マスターデータの取り込みをキャンセル
End If
Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0 'マスターデータファイルを読み取り専用で開く
'ダイアログボックスで指定したExcel Bを開きます。

Set wbSaki = Workbooks.Open(Path & SetFile) '転記元のシート検索

For i = 1 To ActiveWorkbook.Worksheets.Count 'アクティブブックのシートを全てカウント
If Worksheets(i).Name = sh1name Then 'もし転記元のシートの名前と現在開いているブックのシートの名前が一緒だったら
flag = True

wbSaki.Worksheets(i).Range("G2:N32").Copy
wbMoto.Worksheets(sh1name).Range("G2:N32").PasteSpecial xlPasteFormulasAndNumberFormats

End If
Next i
If flag <> True Then 'フラグが"True"ではなかったら
MsgBox sh1name & "シートはありません。", vbInformation 'シートはありませんの情報メッセージアイコンが出る
wbSaki.Close False 'ExcelBのファイルを閉じる
End If

Application.CutCopyMode = False 'コピー切り取りを解除
wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる
Else
MsgBox "処理を中断します"
End If
Application.DisplayAlerts = True
End Sub

No.1 回答者： Qchan1962 回答日時： 2021/11/15 17:54

こんばんは、

コードを検証していませんが、

フローを整理して考えると良いのではと思います。
コメントとコードがあいまい部分があり良く分かりません。

sh1name = ActiveSheet.Name '現在開いているシート名
Set wbMoto = ActiveWorkbook 'マスターデータ取り込み元をセット
これは、両方共にVBAが実行されたブックですね。

①実行されたシート名とブックを変数に登録
②コピー元のブックをUIで指定
③コピー元ブックを開く
④シート名が同じか調べ同じなら範囲をコピー
⑤実行されたシートに同じ範囲に数式と数値の書式で貼り付け
⑥無かった場合の表示
⑦コピー元ブックを閉じる
でしょうか、、これは合っていますか？

＞転記先に貼り付けがされません。
転記先とはどのブックですか？
VBA実行ブック？　UIで指定したブック？　それともさらに違うブック？

この回答へのお礼

こんばんは。
ご回答ありがとうございます！

①～⑦までの手順で間違いありません。
④ですが、実行ブックにaaaシートがあり、UIブックにもあったら貼り付け、実行ブックbbbがあり、UIブックにもbbbがあったら貼り付けるようにしたいです。
転記先はVBA実行ブックです。UIで指定したブックから実行ブックに貼り付けたいです。

よろしくお願いいたします。

お礼日時：2021/11/15 18:02

No.2 回答者： Qchan1962 回答日時： 2021/11/15 18:10

＃１です

想像の範疇ですが、処理に必要なブックは2つでなく3つなのでしょうか？

Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0

Set wbSaki = Workbooks.Open(Path & SetFile) '転記元のシート検索
同じパスを示しているけれど変数Path の値設定もされていないようですが、
わざわざ変数Pathを書いている事などから想像して別ブックを開きたいのかな？

いずれにしても、フローなどを書いて整理してみるのが良さそうですね。

No.3 回答者： Qchan1962 回答日時： 2021/11/15 18:15

＞④ですが、実行ブックにaaaシートがあり、UIブックにもあったら貼り付け、実行ブックbbbがあり、UIブックにもbbbがあったら貼り付けるようにしたいです。

このaaa , bbb は一度の実行で行いたいのでしょうか？
aaaは　sh1name = ActiveSheet.Name '現在開いているシート名
で変数に代入されていますが、bbbはどのように取得するのでしょうか？

予めaaa,bbbが分かっているのなら、簡単だけれども、、、
、、、コード添削しても構いませんか？

この回答へのお礼

ありがとうございます。
処理に必要なブックは２つです。
VBAは知識不足ですので、添削は大変勉強になります。お願いいたします。
aaa,bbbは可能であれば一度の実行で行いたいです。
具体的に申し上げますと、UIブックも実行ブックにも名前のシートが記載してあり、UIブックにある名前のシートが実行ブックにもあったら転記という形にしたいです。

よろしくお願いいたします。

お礼日時：2021/11/15 18:35

No.4 回答者： Qchan1962 回答日時： 2021/11/15 18:51

＞aaa,bbbは可能であれば一度の実行で行いたいです。

後に置いときますね。家に帰ってご飯食べないといけないので、、

先ずは、添削してしまいますが、このコードは　 '選択したファイルを取り込み、別のファイルに貼り付ける　とあるので3つのブック（実行ブックを含む）を操作するプロシージャが基になっているようですね

参考サイトなどを駆使して作っていく場合、やりたい処理のフローチャートなどをしっかり作り（理解できていれば良いですが）進めるのが良いと思います。不要な部分を消すのは、意外と面倒なので。。

出来るだけ、、同じように書き、コメントを入れました。
書き方は、人それぞれなので参考とするべきかはわかりません。
一応、デバッグしてみましたが、あくまでサンプルですのでデバッグしてください。
コメントが付き読みにくいのでVBEに貼り付けて読む方が良いと思います。

Sub test_マスターデータ取り込み() '選択したファイルを取り込み、実行ブックのActiveSheetに貼り付ける
Dim RC As Integer
Dim OpenFileName As String
Dim wbMoto As Workbook, wbSaki As Workbook
Dim sh1name As String
Dim i As Long
Dim flag As Boolean
'VBA実行ブック
sh1name = ActiveSheet.Name '現在開いているシート名
Set wbMoto = ActiveWorkbook 'マスターデータ取り込みブックをセット
'コピー元ファイルの選択
'インフォメーション
RC = MsgBox("Excel マスターデータファイルを開きますか?", vbYesNo + vbQuestion, "確認")
If RC = vbNo Then MsgBox "処理を中断します": Exit Sub 'もしRCのメッセージにNOと答えたら終了
'ファイルピックアップダイアログ
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
If OpenFileName = "False" Then MsgBox "キャンセルされました": Exit Sub 'もし指定したファイルがFalseなら終了

'画面抑制
Application.ScreenUpdating = False

'ダイアログボックスで指定したExcel マスターデータファイルを読み取り専用で開く。
Set wbSaki = Workbooks.Open(fileName:=OpenFileName, ReadOnly:=True, UpdateLinks:=0)
'開いたブック内シートすべてに対して処理
For i = 1 To wbSaki.Worksheets.Count
If Worksheets(i).Name = sh1name Then 'もし転記元のシートの名前と現在開いているブックのシートの名前が一緒だったら
flag = True 'インフォメーションフラグ
wbSaki.Worksheets(i).Range("G2:N32").Copy '該当シートの範囲をコピー　し　実行ブックに数式と数値の書式で貼り付け
wbMoto.Worksheets(sh1name).Range("G2:N32").PasteSpecial xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False 'コピー切り取りを解除
wbSaki.Close SaveChanges:=False 'マスターデータ取り込み先のファイルを保存せずに閉じる
Exit For '2つ同名シートはあり得ないので無駄な処理をやめループを抜ける
End If
Next i

If flag <> True Then 'フラグが"True"ではなかったら（シートが見つからなければ）
MsgBox sh1name & "シートはありません。", vbInformation 'シートはありませんの情報メッセージアイコンが出る
wbSaki.Close SaveChanges:=False 'マスターデータ取り込み先のファイルを保存せずに閉じる
End If
'画面抑制解除
Application.ScreenUpdating = True

End Sub

No.5 ベストアンサー 回答者： Qchan1962 回答日時： 2021/11/15 19:16

＞aaa,bbbは可能であれば一度の実行で行いたいです。

なさりたい事とあっているかは不明ですが、すべてのシートをすべてのシートと突き合せるので良ければ、下記のような感じで良いと思いますが、除外したい同名シートなどがある場合不具合の発生が懸念されます。

該当部分

'開いたブック内シートすべてに対して処理
Dim sH As Variant
For Each sH In wbMoto.Worksheets
For i = 1 To wbSaki.Worksheets.Count
If Worksheets(i).Name = sH.Name Then 'もし転記元のシートの名前と現在開いているブックのシートの名前が一緒だったら
flag = True 'インフォメーションフラグ
wbSaki.Worksheets(i).Range("G2:N32").Copy '該当シートの範囲をコピー　し　実行ブックに数式と数値の書式で貼り付け
wbMoto.Worksheets(sH.Name).Range("G2:N32").PasteSpecial xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False 'コピー切り取りを解除
Exit For '2つ同名シートはあり得ないので無駄な処理をやめループを抜ける
End If
Next i
Next sH

wbSaki.Close SaveChanges:=False 'マスターデータ取り込み先のファイルを保存せずに閉じる

If flag <> True Then 'フラグが"True"ではなかったら（シートが見つからなければ）

上下1行は重複部分
検証はコピーブックでステップ実行などで確認しながら、どうぞ、、

この回答へのお礼

ありがとうございます！！！
できました！！

これは私ではわからなかったです。。
大変参考になりました。
このコードを見て勉強させて頂きます。

ありがとうございます！

お礼日時：2021/11/15 19:40