既存ブックへのシートコピー

Question

保存対象のシートを別ブックにコピーして保存するようなマクロを組んだのですが、既存ブックが初期状態(sheet1)のみだった場合、sheet1に対してシートコピーを行い、それ以降は右に追加されていくようにしたいのです。
どうにかならないでしょうか？
現在は [sheet1] [追加sheet1][追加sheet2]のように追加されていく状態です。

[sheet1] [追加sheet1][追加sheet2] ： 現在
[追加sheet1][追加sheet2] ： 理想

Set wb = Workbooks.Open("C:\Users\Desktop\aaa.xlsx")
chk = Workbooks(wb.Name).Sheets.Count
yyyymmdd = Left(ActiveSheet.Name, 8)
’連番処理
If InStr(wb.Sheets(chk).Name, yyyymmdd) <> 0 Then
pos = InStrRev(wb.Sheets(chk).Name, "_")
name = Left(wb.Sheets(chk).Name, pos)
num = Val(Mid(wb.Sheets(chk).Name, pos + 1)) + 1
ActiveSheet.Name = name & num
End If

ActiveSheet.Copy After:=wb.Sheets(chk)
Application.DisplayAlerts = False
wb.Save
wb.Close
Application.DisplayAlerts = True

シートをYYYYMMDD形式の連番で保存していくのでその処理が含まれています。

Answer 1

Workbooksコレクションに含まれるシートをゼロにはExcelの仕様上出来ないので、2枚以上のシート数になってから不要なシートを削除するという動作で実装するしかないかと。

あるいはWorksheetオブジェクトに対して.Moveすれば、新しいブックに移動して1枚だけになります。
既存ファイル名で保存すれば同じことにならないでしょうか。

参考：Office TANAKA - Excel VBA講座：シートの操作[コピー/移動する]

Comments

[coko1]

sheet1に保存するシートをコピーして名前を保存するシート名に変えることはできないのでしょうか？

[退会済みユーザー]

シート名の変更は既存シートと被らない必要があるので、事前に被りがないか点検してからシートの.Nameを変更する感じになります。