プロが教える店舗&オフィスのセキュリティ対策術

マクロ初心者です。
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は毎週更新されて私のフォルダに入ってきます】したいのですが
そのような事は可能なのでしょうか?
どなたか分かる方教えてください。お願い致します。

A 回答 (6件)

#3です。



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

こうゆう事でいいのでしょうか。
    • good
    • 0
この回答へのお礼

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

お礼日時:2008/12/23 13:20

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



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

これで解ります??
    • good
    • 0
この回答へのお礼

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

お礼日時:2008/12/23 13:24

う~ん。

エクセルのシートの上書きと言うのができないんだ。
だから、マクロの中で、
----------------------------
1.同じ名前のシートがあるかどうか探す。
2.同じ名前のシートがあったら、そのシートのみ削除する
----------------------------
この2つを入れてあげれば、気兼ねなくシートのコピーをすれば、
上書きした事と同じ事になるよね?
    • good
    • 0
この回答へのお礼

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

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

お礼日時:2008/12/19 11:56

各ブックのシート名に重複がなければいいですけど、仮にシート名に同じ物があると


意図しないシートが上書きされる恐れも考えられそうですけど。
その辺りは大丈夫なのでしょうか?

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

この回答への補足

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

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

補足日時:2008/12/18 20:23
    • good
    • 0

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



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

この回答への補足

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

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

補足日時:2008/12/18 19:23
    • good
    • 0

発想を変えて、コピー先に同じシート名があるか無いかのチェックを入れ、


有れば一旦削除すれば良いのでは?

この回答への補足

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

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

補足日時:2008/12/18 19:06
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!