Ｅｘｃｅｌ マクロで複数ブックのデータを一つのブックにまとめる方法

質問

マクロ初心者です。
1つのフォルダの中に複数のbook（sheetも複数）があります。
これを新しい1つのbookにまとめたいです。
回答に下記マクロがありました。

Sub consolid()
Application.ScreenUpdating = False '画面更新を一時停止
Set mb = ThisWorkbook 'このコピー先ブックをmbとする。
myfdr = ThisWorkbook.Path
fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索
Do Until fname = Empty '全て検索
If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ
Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。
wb.Worksheets.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く
wb.Close '開いたブックを閉じる
n = n + 1 'ブック数をカウント
End If
fname = Dir 'フォルダ内の次のExcelブックを検索
Loop '繰り返す
Application.ScreenUpdating = True '画面更新一時停止を解除
MsgBox n & "件のブックをコピーしましました。"
End Sub

これで使用した所マクロを実行する度に何度も同じシートが
コピーされてしまいます。
できれば同じ名前のシートは上書きにしてマクロを何度も使用できるように【各BOOKは毎週更新されて私のフォルダに入ってきます】したいのですが
そのような事は可能なのでしょうか？
どなたか分かる方教えてください。お願い致します。

回答No.6

n-jun · ベストアンサー

＃３です。

Sub consolid_try()
Dim mb As Workbook
Dim wb As Workbook
Dim ws As Worksheet
Dim cws As Worksheet
Dim myfdr As String
Dim fname As String
Dim n As Integer

Application.ScreenUpdating = False '画面更新を一時停止
Set mb = ThisWorkbook 'このコピー先ブックをmbとする。
myfdr = ThisWorkbook.Path
fname = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索
Do Until fname = Empty '全て検索
If fname <> mb.Name Then 'ブック名がこのブックの名前でなければ
Set wb = Workbooks.Open(myfdr & "\" & fname) 'そのブックを開きwbとする。

On Error Resume Next
For Each ws In wb.Worksheets
Set cws = mb.Worksheets(ws.Name)
If Not cws Is Nothing Then
Application.DisplayAlerts = False
mb.Worksheets(ws.Name).Delete
Application.DisplayAlerts = True
End If
ws.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く
Next
On Error GoTo 0
wb.Close '開いたブックを閉じる
n = n + 1 'ブック数をカウント

End If
fname = Dir 'フォルダ内の次のExcelブックを検索
Loop '繰り返す
Application.ScreenUpdating = True '画面更新一時停止を解除
MsgBox n & "件のブックをコピーしましました。"
End Sub

こうゆう事でいいのでしょうか。

お礼

時間掛かってしまってすいません。
ありがとうございます。難なくできました。素晴しいです！！！！
年末の集約に役に立ちます。

回答No.5

singlecat

ごめん出張で時間ないから、ロジックまで書けないので....

Worksheets.Count
で、シートの合計枚数が取れるので、これをカウント(wCNTとする)１から、合計枚数まで回し、シート名が同じであったら、
Sheets(wCNT).Delete
で、そのシートを消す。

これで解ります？？

お礼

お忙しい中本当にありがとうございました。
結論上記の内容に私の頭が追い付きませんでした。
内容が理解できる所まで勉強できましたので
今後スムーズ分かるように今後より勉強したいと思います。

回答No.4

singlecat

う～ん。エクセルのシートの上書きと言うのができないんだ。
だから、マクロの中で、
－－－－－－－－－－－－－－－－－－－－－－－－－－－－
１．同じ名前のシートがあるかどうか探す。
２．同じ名前のシートがあったら、そのシートのみ削除する
－－－－－－－－－－－－－－－－－－－－－－－－－－－－
この２つを入れてあげれば、気兼ねなくシートのコピーをすれば、
上書きした事と同じ事になるよね？

お礼

＞１．同じ名前のシートがあるかどうか探す。
２．同じ名前のシートがあったら、そのシートのみ削除する
－－－－－－－－－－－－－－－－－－－－－－－－－－－－
この２つを入れてあげれば、気兼ねなくシートのコピーをすれば、
上書きした事と同じ事になるよね？

そうですね。素晴しいです。
その公式が入れれれば上書きした事になります。
しかしすいません・・・・。
その公式を初心者の為全く分かりません。
教えていただけませんか？

回答No.3

n-jun

各ブックのシート名に重複がなければいいですけど、仮にシート名に同じ物があると
意図しないシートが上書きされる恐れも考えられそうですけど。
その辺りは大丈夫なのでしょうか？

⇒例えば１０個のブックにシートがそれぞれ３枚あった場合、３０枚のシート名に重複はないのか？
と言う事です。

補足

ご回答ありがとうございます。
＞例えば１０個のブックにシートがそれぞれ３枚あった場合、３０枚のシート名に重複はないのか？
と言う事です。

はい。ありません。A11月　B11月　C11月・・・となっております。ので重複はありません。

回答No.2

fujillin

フォルダ内のブックが入れ替わったりするのでなければ（データが変わるのはOK、ブックが増加するのもOK）、最初にThisWorkbookのシートを削除しておけば、常に新しいものになりますが・・・

古いものを残しておきたい場合があるのだと、No.1様の回答のようにそれぞれ比べなければならないけど、複数のブックの中でシート名がバッティングしていることはないのでしょうか？

補足

ご回答ありがとうございます。
しかしすいません。意味が分かりません。
＞最初にThisWorkbookのシートを削除しておけば、常に新しいものになりますが・・・
各BOOKの既存のシートは消しておくということでしょうか？・・
既存のシートは現在進行形なので上書きする必要性があります。
自分の見る総合シート一旦全て削除してもう一度マクロ実行させるということでしょうか？
それなら・・・できそうです。でも1シートづつ手作業で消していくって事ですか？
すいません。全然分かっていないかも知れません。

＞複数のブックの中でシート名がバッティングしていることはないのでしょうか？
シート名がバッティングしている事はありません。各グループ名プラス月<例A11月>というシートになっています。

回答No.1

singlecat

発想を変えて、コピー先に同じシート名があるか無いかのチェックを入れ、
有れば一旦削除すれば良いのでは？

補足

すいません。重大な事を付け加えないといけません。
全く初心者です。そのため今、singlecatさんにお答えいただきましたが意味が分かりません・・・(ーー;)多分私の記入の仕方が不充分だと思われます。
各グループのデータと目標、反省、現在の進行状況がエクセルのファイルで1ヶ月1シートの形式で提出されてきます。
例えば今現在ですと12月の進行状況もかかれていますし1月の目標も別シートには書かれていますので
マクロを実行する際には既存のシートは上書きを新しいシートがあるものは新規でコピーする必要性があります。
例えばややこしいので各月あたり1ファイルにしたとしても、マクロを実行する度に新しくコピーされるのでは意味が無いのですが・・・

これはどうにかできないものなのでしょうか・・・・？？？