下記のマクロは先ほど教えて頂いたマクロで
コピー元の指定シートとセル値をコピー先にコピペできます。
Sub Macro1()
Call 採光シートコピー範囲
Call 貼り付け
Call 採光データ削除
End Sub
張り付けた後に
コピー元のファイルが不要の為、マクロ「採光データ削除」を実行して、ファイルを削除したいのですが、削除対象のファイルが開いた状態なので、エラーメッセージが出て、ファイルを削除できません。
以前教えて頂いたコードをそのまま利用しており、コピー元のファイルのコピー範囲が完了するとこのファイルは閉じると思うのですが、なぜか、開いたままの状態です。
それぞれのマクロを書き込みますので、解決方法を教えてください。
Sub 採光シートコピー範囲()
Dim folderPath As String
Dim fileName As String
Dim ws As Worksheet
folderPath = ThisWorkbook.Path & "\"
'作業フォルダ内にはマクロを設定しているコピー先のブックとコピー元の
' 採光計算確認.xlsxの 2つ のExcelファイルしかありません。
fileName = Dir(folderPath & "*.xlsx?")
Do While fileName <> ""
If CheckName(fileName) = True Then Exit Do
fileName = Dir()
Loop
If fileName <> "" Then
'別ブック 採光計算書.xlsx
Set Wb2 = Workbooks.Open(folderPath & fileName)
On Error Resume Next
Set ws = Wb2.Worksheets("Table 2")
If Err.Number <> 0 Then
MsgBox "コピー元ブックの提出シートが見つかりません"
On Error GoTo 0
Wb2.Close False
End
End If
'セルの値を取得する
ws.Range("A1:W51").Copy
On Error GoTo 0
ws.Activate
ws.Range("A1:W51").Copy
Else
MsgBox "コピー元ブックが見つかりません": End
End If
End Sub
Private Function CheckName(ByVal fileName As String) As Boolean
CheckName = False
If fileName = ThisWorkbook.Name Then Exit Function
CheckName = True
If LCase(Right(fileName, 5)) = ".xlsx" Then Exit Function
If LCase(Right(fileName, 5)) = ".xlsm" Then Exit Function
CheckName = False
End Function
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("A1:W52").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Sub 採光データ削除()
Dim filePath As String
filePath = ThisWorkbook.Path & "\採光計算書.xlsx"
If Dir(filePath) <> "" Then
Kill filePath
End If
End Sub
以上となります。
よろしくお願いいたします。


No.6ベストアンサー
- 回答日時:
たぶんうまく動かないからレスが無いのかなと・・
閲覧があまりできないので
1つにまとめ簡単にデバッグしたコードです
試してみてください
あくまで素人の個人的意見ですがプロシージャを分けるのも良いけれど
繰り返し使う事もなくあまり複雑でもないし サブで定数(決まった値)を使っているのであれば、あまり意味ないと思いますよ
と この回答もあまり意味はありませんね
Sub Macro1()
Dim Wb1 As Workbook, Wb2 As Workbook
Dim ws As Worksheet, ws1 As Worksheet
Dim folderPath As String
Dim fileName As String
Const destination_sheet As String = "採光確認"
Const source_book As String = "採光計算書.xlsx"
Const source_sheet As String = "Table 2"
Set Wb1 = ActiveWorkbook
Set ws1 = objSht(Wb1, destination_sheet)
If ws1 Is Nothing Then
MsgBox "コピー先ブック:" & Wb1.Name & "の" & destination_sheet & "シートが見つかりません"
Exit Sub
End If
folderPath = ThisWorkbook.Path
fileName = Dir(folderPath & "\" & source_book)
If fileName <> "" Then
Application.ScreenUpdating = False
Set Wb2 = Workbooks.Open(folderPath & "\" & fileName)
Set ws = objSht(Wb2, source_sheet)
If ws Is Nothing Then
MsgBox "コピー元ブック:" & source_book & "の" & source_sheet & "シートが見つかりません"
Wb2.Close False
Set Wb2 = Nothing
Application.ScreenUpdating = True
End
End If
Else
MsgBox "コピー元ブック:" & source_book & "が見つかりません": End
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
'セルの値を取得する
ws.Activate
ws.Range("A1:W51").Copy
ws1.Range("A1:W51").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
If Not Wb2 Is Nothing Then Wb2.Close False
Application.CutCopyMode = False
Kill fileName
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Function objSht(bk As Workbook, sName As String) As Object
Dim obj As Object
On Error Resume Next
Set obj = bk.Worksheets(sName)
On Error GoTo 0
Set objSht = obj
End Function
#5は適当にコピペしただけなので 忘れてください
No.5
- 回答日時:
あれ?閉じてないから削除できないではなかったかのかな
書き直してほしいわけ?
Option Explicit
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim ws1 As Worksheet
Sub Macro1()
Set Wb1 = ActiveWorkbook
On Error Resume Next
Set ws1 = objSht(Wb1, "採光確認")
If ws1 Is Nothing Then
MsgBox "コピー先ブックの受付シートが見つかりません"
Exit Sub
End If
Call 採光シートコピー範囲
Call 貼り付け
Call 採光データ削除
End Sub
Sub 採光シートコピー範囲()
Dim folderPath As String
Dim fileName As String
Dim ws As Worksheet
folderPath = ThisWorkbook.Path & "\採光計算確認.xlsx"
fileName = Dir(folderPath)
If fileName <> "" Then
Set Wb2 = Workbooks.Open(folderPath & fileName)
Set ws = objSht(Wb2, "Table 2")
If ws Is Nothing Then
MsgBox "コピー元ブックの提出シートが見つかりません"
Wb2.Close False
Set Wb2 = Nothing
End
End If
'セルの値を取得する
ws.Activate
ws.Range("A1:W51").Copy
Else
MsgBox "コピー元ブックが見つかりません": End
End If
End Sub
Private Function objSht(bk As Workbook, sName As String) As Object
Dim obj As Object
Set obj = bk.Worksheets(sName)
Set objSht = obj
End Function
Sub 貼り付け()
Application.DisplayAlerts = False
Application.EnableEvents = False
ws1.Range("A1:W52").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
If Not Wb2 Is Nothing Then Wb2.Close False
Set Wb2 = Nothing
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Sub 採光データ削除()
Dim bk As Workbook
Dim filePath As String
filePath = ThisWorkbook.Path & "\採光計算書.xlsx"
'念のため
For Each bk In Workbooks
If bk.FullName = filePath Then
bk.Close False
Exit For
End If
Next
If Dir(filePath) <> "" Then
Kill filePath
End If
End Sub
分ける必要性を感じないけれど 必要なのかもしれないから
分けています
Sub 採光データ削除()は単独でも実行可能なようにしています
No.4
- 回答日時:
提示されたマクロを格納しているのは、
①採光計算確認.xlsm でしょうか。
②採光計算確認.xlsm以外のブック
のどちらでしょうか。
私は②であると判断して、補足要求を行いましたが、
①でしょうか。
No.3
- 回答日時:
補足要求です。
1.コピー元/コピー先のブック名、シート名、セル位置の確認です。
下記であってますか。
コピー元のブック名:採光計算書.xlsx
コピー元のシート名:Table 2
コピー元セル:A1:W51
コピー先のブック名:不明
コピー先のシート名:採光確認
コピー先のセル:A1:W52
①コピー先のブック名が不明です。拡張子も含めて正しく、提示してください。
②コピー先のセル範囲は、A1:W51が正しいと思いますが、いかがでしょうか。(A1:W52は誤り)
2.コピー元のブック、コピー先のブックは、マクロのあるブックと同じフォルダに格納されている前提で良いですか。
3.現行のマクロをみると、マクロ実行時
コピー元のブックはクローズしている。(マクロがオープン)
コピー先のブックはオープンされている。(マクロはオープンしない)
となっていますが、それが望まれる仕様でしょうか。
コピー先のブックもクローズされている状態で、マクロを起動し、マクロがコピー先のブックを
オープンするようにすることも可能です。
4.コピー元のブックをオープンする時、ワイルドカード指定(*.xlsx?)
でファイル名を取得していますが、今回は、ファイル名が、"採光計算書.xlsx"
と決定しているので、直接そのファイルをオープンしたほうが良さそうです。
ワイルドカード指定にこだわる理由がなければ、直接ファイル名を指定してオープン
するようにしたいのですが、いかがでしょうか。
No.2
- 回答日時:
Wb2の宣言はモジュールレベルなのかな?
使いまわししているカモで
If Not Wb2 Is Nothing Then Wb2.Close False
下に一応加えた方が良いかも・・
Set Wb2 = Nothing
No.1
- 回答日時:
示されているコードについては突っ込みどころ満載ですが・・
対応策だけ・・・
>削除対象のファイルが開いた状態なので
原因が分かっているのなら・・処理レスポンスは置いときますが閉じればよいのでは?
コピペでの回答
ws1.Range("A1:W52").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
If Not Wb2 Is Nothing Then Wb2.Close False
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2024/07/04 08:52
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2024/07/01 15:23
- Visual Basic(VBA) エクセルのマクロについて教えてください。 7 2024/07/03 09:22
- Visual Basic(VBA) エクセルのマクロについて教えてください。 7 2024/07/01 09:07
- Visual Basic(VBA) Excelのマクロについて教えてください。 2 2024/06/14 16:38
- Visual Basic(VBA) VBA 1 2024/02/03 22:51
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2024/07/02 08:51
- Visual Basic(VBA) VBAのユーザーフォームのテキストボックスに入力制限をしたい 6 2022/11/15 08:28
- Visual Basic(VBA) VBAの間違い教えて下さい 5 2024/08/03 21:35
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2024/03/26 18:09
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBAでCOPYを繰り返すと、処理が...
-
【マクロ】並び替えの範囲が、...
-
【マクロ】オートフィルター を...
-
Vba Array関数について教えてく...
-
Vba 型が一致しません(エラー1...
-
【ExcelVBA】値を変更しながら...
-
vbsでのwebフォームへの入力制限?
-
エクセルのマクロについて教え...
-
【ExcelVBA】5万行以上のデー...
-
VBAでセルの書式を変えずに文字...
-
【マクロ】開いているブックの...
-
Vba セルの4辺について罫線が有...
-
vb.net(vs2022)のtextboxのデザ...
-
Excel VBA 選択範囲の罫線色の...
-
【マクロ】売上一覧YYYYMMDDHHS...
-
エクセルの改行について
-
VBAで特定の文字が入った行をコ...
-
WindowsのOutlook を VBA から...
-
Excel 範囲指定スクショについ...
-
【マクロ】シートの変数へ入れ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Vba セルの4辺について罫線が有...
-
vbsでのwebフォームへの入力制限?
-
【ExcelVBA】5万行以上のデー...
-
【マクロ】売上一覧YYYYMMDDHHS...
-
【マクロ】開いているブックの...
-
【マクロ】並び替えの範囲が、...
-
エクセルの改行について
-
エクセルのマクロについて教え...
-
vb.net(vs2022)のtextboxのデザ...
-
VBAでCOPYを繰り返すと、処理が...
-
VBA ユーザーフォーム ボタンク...
-
エクセルのVBAコードと数式につ...
-
エクセルのVBAコードについて教...
-
[VB.net] ボタン(Flat)のEnable...
-
【マクロ】変数を使った、文字...
-
改行文字「vbCrLf」とは
-
質問58753 このコードでうまく...
-
【マクロ】シートの変数へ入れ...
-
ワードの図形にマクロを登録で...
-
算術演算子「¥」の意味について
おすすめ情報






1.コピー元/コピー先のブック名、シート名、セル位置の確認です。
下記であってますか。
コピー元のブック名:採光計算書.xlsx
コピー元のシート名:Table 2
コピー元セル:A1:W51
以上全てあっております。
コピー先のブック名:採光計算確認.xlsm
コピー先のシート名:採光確認
コピー先のセル:A1:W51 が正しいです。
2.コピー元のブック、コピー先のブックは、マクロのあるブックと同じフォルダに格納されている前提で良いですか。
はい、同じフォルダ内に格納されております。
コピー元及びコピー先のファイル名は固定です。
よろしくお願いいたします。
ご親切にありがとうございます。
教えて頂いたコードを全て設定し、
マクロを実行しましたが、画像のエラーが出てしまい、実行できませんでした、
何度も申し訳ありません。
よろしくお願いいたします。
補足要求です。
1.コピー元/コピー先のブック名、シート名、セル位置の確認です。
下記であってますか。
コピー元のブック名:採光計算書.xlsx
コピー元のシート名:Table 2
コピー元セル:A1:W51
はい、以上で全てあっております。
コピー先のブック名:採光計算確認.xlsm になります。
コピー先のシート名:採光確認
コピー先のセル:A1:W51 で間違いでした。
コピー元及びコピー先のファイル名は固定です。
よろしくお願いいたします。
先ほど補足をさせて頂きましたが
提示されたマクロを格納しているのは、
①採光計算確認.xlsm です。
よろしくお願いいたします。
何時も助けて頂きましてありがとうございます。
全て上手くできました。感謝、感謝です。