Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

19165 / 76734

←次へ　｜　前へ→


	【63005】古いシートの削除

ヒロ - 09/9/30(水) 19:14 -


	引用なし

	パスワード

データーを入力しているブックを閉じる際にそのシートを他のブックに
バックアップするコードをこちらの質問箱で教えていただいたのですが
シートの枚数がどんどん増えていくので、手動で削除しています。

シート名を日付にしているので、バックアップ時の日付より１０日ぐらい
以前のシートを削除する方法を教えていただけませんでしょうか？
よろしくお願いいたします。

バックアップのコードです。

Sub SheetCopy()
　Dim ws As Worksheet
　Dim dName As String
　Dim blnWs As Boolean '★

　dName = Format(Now(), "yy-mm-dd") '01-02-14

　Application.ScreenUpdating = False
　Sheets("運送DATA").Select
　Range("A2").Select

　If Range("A2").Value = "" Then '★
　　'MsgBox "A2セルに値がありません" '★
　Else
　　Cells.Copy
　
　　Workbooks.Open ThisWorkbook.Path & "\Backup.xls"
　　blnWs = False '★シートが見つからない
　　For Each ws In Worksheets
　　　If ws.Name = dName Then
　　　　blnWs = True '★'シートが見つかった
　　　　ws.Activate '★
　　　　With ActiveSheet
　　　　　.Range("A1").Select
　　　　　.Paste
　　　　　.Range("A2").Select
　　　　End With
　　　　Exit For
　　　End If
　　Next
　
　　If Not blnWs Then '★シートが見つからなかったとき
　　　ActiveWorkbook.Worksheets.Add
　　　ActiveSheet.Name = Format(Now(), "yy-mm-dd") '01-02-14
　　　With ActiveSheet
　　　　.Range("A1").Select
　　　　.Paste
　　　　.Range("A2").Select
　　　End With
　　End If '★
　End If
　ActiveWindow.Zoom = 85
　ActiveWorkbook.Save　　　　　　　　'上書き
　ActiveWorkbook.Close　　　　　　　 '閉じる
　Application.ScreenUpdating = True
End Sub

3 hits

▼

【63005】古いシートの削除 ヒロ 09/9/30(水) 19:14

≪