エクセルのマクロについて教えてください。

下記のマクロは教えて頂いたマクロです。
コピー先にマクロを設定しており、マクロを実行するとコピー元のブックが開き、コピー範囲を指定して、コピー元の指定範囲にコピペ出来、その後、不要となったコピー元のブックを削除できます。
しかし、コピペまでは上手く実行出来ましたが、
不要ブックを削除できませんでした。
解決方法を教えてください。
Sub Macro1()
On Error Resume Next
Dim folderPath As String
Dim fileName As String
folderPath = ThisWorkbook.Path & "\"
fileName = Dir(folderPath & "*(提出用).xlsx")
If fileName <> "" Then
Workbooks.Open folderPath & fileName
Else
MsgBox "コピー元ファイルがありません", , "確認"
Exit Sub
End If

Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks(1) 'このブック
Set Wb2 = Workbooks(2) '別ブック
'セルの値を取得する
Application.DisplayAlerts = False
Application.EnableEvents = False
Wb2.Worksheets("提出シート").Range("B1:H47").Copy
Wb1.Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
With Wb2
If .Name Like "#########-#*" Then
If MsgBox(.Name & " を削除します", _
vbCritical + vbOKCancel, "警告！") = vbOK Then
.Save
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close (False)
End If
End If
End With
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

以上となります。
よろしくお願いいたします。

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

• 削除したいファイルは、コピー元のファイルでワイルドカードを使用している「*(提出用).xlsx」になります。
  よろしくお願いいたします。

    補足日時：2024/07/01 15:43

• 回答ありがとうございます。
  おっしゃる通り
  少し自分で色々試してみます。
  明日になりますが、又、連絡をさせて頂きます。
  一日、教えて頂きまして、感謝感謝です。

  No.1の回答に寄せられた補足コメントです。 補足日時：2024/07/01 17:39

No.2 回答者： fujillin 回答日時： 2024/07/01 16:17

こんにちは

読み取り専用に変えて、ファイルを開いたまま削除しようとしているようですが、普通にクローズしてから削除すればできませんか？
もしも、ファイル本体がアクセス権設定等で削除不可になっている場合は、そこを変えない限り削除はできませんけれど・・・

コード内で警告等を止めてしまっていますけれど、エラーの際にどのような警告が出るのか（出ないのか）、エラーメッセージの内容はどうなっているかをよく読んで、それに従って対処すれば良いはずです。
質問者様は「できる/できない」だけで判断しているようですが、実際にはいろいろと情報があるはずなので、それらを活用してください。
（これらの情報に関して何の記載もないので、回答者には「できない」という事象しかわかりません）

この回答へのお礼

回答ありがとうございます。
参考にさせて頂きます。

お礼日時：2024/07/01 17:40

No.1 回答者： Qchan1962 回答日時： 2024/07/01 16:11

試したけれど

コピー元のブックは削除されましたが・・・？
出来ないの？

関係ない事ですが
元の様にロジック分けしたいという事でしたので　
個別に呼ぶ場合のエラー対策を入れて・・

モジュールレベル変数が分からないという事なので
新しい標準モジュールで試してください
注：他の処理から呼ぶ場合　Application.EnableEvents = True　のタイミングを考慮してください

いずれにしても自身で行う事が大事です

’---ここから下全て

Dim Wb1 As Workbook
Dim Wb2 As Workbook
Sub Sample()
Call 提出シートを開く
Call 提出シートコピー範囲
Call 貼り付け
Call 電子提出削除
End Sub

Sub 提出シートを開く()
Dim folderPath As String
Dim fileName As String
folderPath = ThisWorkbook.Path & "\"
fileName = Dir(folderPath & "*(提出用).xlsx")
Do While fileName <> ""
Workbooks.Open (folderPath & fileName)
fileName = Dir()
Loop
End Sub

Sub 提出シートコピー範囲()
Dim ws As Worksheet
If Workbooks.Count > 1 Then
Set Wb2 = Workbooks(2) '別ブック
On Error Resume Next
Set ws = Wb2.Worksheets("提出シート")
If Err.Number <> 0 Then
MsgBox "コピー元ブックの提出シートが見つかりません"
On Error GoTo 0
Wb2.Close False
End
End If
'セルの値を取得する
ws.Range("B1:H47").Copy
Else
MsgBox "コピー元ブックが見つかりません": End
End If
End Sub

Sub 貼り付け()
Dim ws1 As Worksheet
Set Wb1 = Workbooks(1) 'このブック
On Error Resume Next
Set ws1 = Wb1.Worksheets("受付")
If Err.Number <> 0 Then
MsgBox "コピー先ブックの受付シートが見つかりません"
Application.CutCopyMode = False
On Error GoTo 0
If Not Wb2 Is Nothing Then Wb2.Close False
End
End If

Application.DisplayAlerts = False
Application.EnableEvents = False
ws1.Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

Sub 電子提出削除()
Dim wb As Workbook
For Each wb In Workbooks
With wb
If .Name Like "#########-#*" Then
If MsgBox(.Name & " を削除します", _
vbCritical + vbOKCancel, "警告！") = vbOK Then
.Save
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close (False)
Exit For
End If
End If
End With
Next
End Sub