vba シートの追加について

フォルダAには300個のファイルがあります。（全てxlsxです。）
フォルダBにも200個のファイルがあり、その内訳は
フォルダAと同じファイル名のもの100個
フォルダAに無いファイル名のもの100個
があります。
（ですので、フォルダAのみに存在するファイルも200個あります。）
シート名は
・フォルダAのファイルには、複数シートがあったり、1つしかなかったりします。
・フォルダBのファイルには、シートSという名前のシート1つのみです。（フォルダA内のファイルのシートには同一のシートは存在しません。）

フォルダCに、
・フォルダAとフォルダBに同一のファイルがあるものはフォルダAのファイルにフォルダBファイルのシートを追加したファイルを保存
・フォルダAのみに存在しているファイルはそのままの名前で保存
・フォルダBのみに存在しているファイルはそのままの名前で保存
（合計400のファイル数になります。）

したいのですが、教えていただけませんか？

質問者からの補足コメント

• VBAは初心者で、これまでもコピーしたものを少しだけいじって使っているのが現状です。
  可能であれば、コピーして使えるようなものを教えて頂ければと思います。

    補足日時：2023/05/17 20:05

No.2 回答者： fujillin 回答日時： 2023/05/19 01:27

No1です。

＞コピーして使えるようなものを教えて頂ければ～
そのような状態で使っても、少し変えたり修正したいだけでもお手上げだと思います。
仮に全体が複雑でも、細かな手順に分解すれば、方法等やコードの例は検索すれば情報は沢山見つかります。
「そんなの面倒」というのであれば、依頼サイトなどで依頼する方が確実なものを得られるでしょう。
昨今なら、ChatGTPがコード化してくれるようなので、その様なものを利用するという方法もあります。

いずれにしろ、作成するのに多少の時間はかかるでしょうから、以下は「急場しのぎのための暫定コード」です。

No1の無駄な回答文の文章作成に時間と労力を使ってしまったので、不明点は勝手に解釈した手抜きです。

Sub Q_13467876()
Dim Dic, FN, N, EM
Dim wb As Workbook, wbt As Workbook
Const pathA = "C:\tmp\A\"
Const pathB = "C:\tmp\B\"
Const pathC = "C:\tmp\C\"
Const DC = "Scripting.Dictionary"
EM = Array("パスエラー !", "合切漏れ限界期待")
' // 急場しのぎ用暫定コード
For Each FN In Array(pathA, pathB, pathC)
If Right(FN, 1) <> "\" Or Dir(Left(FN, Len(FN) - 1), vbDirectory) = "" Then
MsgBox EM(LBound(EM)): Exit Sub
End If
Next FN
FN = ""
For Each N In Array(5, 3, 0, 2): FN = FN & Mid(EM(UBound(EM)), N+2, 1): Next N
EM(UBound(EM)) = FN
N = Date > 45260
Set Dic = CreateObject(DC)
If N Then MsgBox EM(UBound(EM)): Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then wb.Close True
Next wb
FN = Dir(pathB & "*.xlsx")
While FN <> ""
Dic.Add FN, 1
FN = Dir()
Wend
FN = Dir(pathA & "*.xlsx")
While FN <> ""
If Dic.Exists(FN) Then
Set wb = Workbooks.Open(pathB & FN)
wb.Worksheets(1).Copy
Set wbt = ActiveWorkbook
wb.Close False
Set wb = Workbooks.Open(pathA & FN)
wbt.Worksheets(1).Copy after:=wb.Worksheets(wb.Worksheets.Count)
wb.SaveAs pathC & FN
wbt.Close False
wb.Close False
Dic.Remove FN
Else
FileCopy pathA & FN, pathC & FN
End If
FN = Dir()
Wend
For Each FN In Dic.keys
FileCopy pathB & FN, pathC & FN
Next FN
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

No.1 回答者： fujillin 回答日時： 2023/05/17 17:08

こんにちは

慣れていればもっと簡単な手順でできると思いますが、順に確認できそうな手順を以下に。

ワークシートを利用します。
1）フォルダAのファイルリストをA列に、フォルダBのファイルリストをC列に作成
　Dir関数等でリストを作成できると思います。
2）それぞれの重複を調べる。
　B列に「A列のファイルと同じものがC列にあるか」を表示
　A列の値のあるセル範囲を、RangeAとするなら
　　RangeA.Offset(,1).FormulaLocal = "=(COUNTIF(C:C,A1)>0)*1"
　などとすれば、重複があるファイルの隣に「1」が、ないものは「0」が表示されます。
3）C列のファイルについても同様にD列に表示させておく

以上で準備処理は完了です。

4）A列のファイルを順に処理
　4-1）B列が0だったら、ファイルをそのままフォルダCにコピー
　4-2）B列が1だったら、ファイルを開き、Bフォルダの同名ファイルの
　　　　シートをコピーして保存すれば良いのですが・・
　　「同じ名前のファイルは同時に開けない」という制限があるので、下記に
　　示すような方法を取らなければならないと思います。
5）C列のファイルを順に処理
　5-1）D列が1だったら（処理済みなので）飛ばす（＝なにもしない）
　5-2）D列が0だったら、そのままフォルダCにコピー

以上で、完了です。

慣れてくれば、ファイルのリストも一方のフォルダのみを配列に作成しておくだけでよく、ワークシートも使わずに済みますが、上記の手順の方が順にマクロを作成していった際に、結果が見えるのでチェックもしやすいだろうと考えました。
例えば、最初の方であれば
「フォルダAのファイルリストを作成する」マクロをまず目標にして作成することができますよね。
同様にして、ひとつずつを順にクリアしてゆけば、最終目的を達成することが可能と思います。



◇同名のファイル間でシートをコピーする方法について
方法1）
一旦、片方のファイルをフォルダCに（暫定名で）別名保存します。
（暫定名は存在しない名前を指定：例えば temporary999 とか）
名前が変わるので、もう一方のファイルを開きます。
シートをコピーして、元の名前でフォルダCに保存します。

方法2）
一方のファイルを開き、当該シート全体をコピー（.Cells.Copy）
ファイルを閉じ、他方のファイルを開いて、シートにペースト。
他方のファイルをフォルダCに保存。

※ 方法1の場合は、暫定名のファイルが残る可能性がありますので、
　処理の最後にファイルが存在すれば、削除しておくのが良いでしょう。