下記のマクロを実行すると画像のエラーメッセージが表示されマクロ「貼り付け」のコードの内「Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats」が黄色く表示されて上手くマクロを実行できません。
一連のマクロでは無く、手動で行うと上手く行きます。この問題を解決できる方法を教えてください。
何時もの作業の手順として、マクロ設定ブック:コピー先を開く(手動)次にコピー元のブックを開く(手動)次にコピー元のコピー範囲を指定(手動)次にコピー先のブックに貼り付け(マクロ:貼り付け)を実行次にコピー元のブックの削除(マクロ:電子提出削除)を日々行っており、この手順だとエラーが出ずにコピー元の指定範囲をコピー先の指定範囲にコピー出来、コピー元のファイルを削除できます。しかし、一連のマクロだとエラーメッセージが表示されます。
一連のマクロのままで上手くできる方法があるものですか?又、一連のマクロを一つのマクロとすると上手く行きますか?詳しく教えてください。よろしくお願いいたします。
一連のマクロ
Call 提出シートを開く
Call 提出シートコピー範囲
Call 貼り付け
Call 電子提出削除
End Sub
それぞれのマクロ
Sub 提出シートを開く()
On Error Resume Next
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 Wb1, Wb2
Set Wb1 = Workbooks(1) 'このブック
Set Wb2 = Workbooks(2) '別ブック
'セルの値を取得する
Wb2.Worksheets("提出シート").Range("B1:H47").Copy
End Sub
Application.DisplayAlerts = False
Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
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
以上となります。
日々この作業を多い時で数十回行います。以前も同じような質問をしておりますが、解決には至っておりません。是非、解決方法を教えてください。よろしくお願いいたします。
No.7ベストアンサー
- 回答日時:
#3で
Wb1.Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
と回答しているが・・・
Sub 貼り付け()
Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub
って何の話?
>私としては、出来れば一連のマクロを実行でお願いしたいと考えております、その後に今回削除したコードをシート名「審査」にVBAコードとして設定したいと思います。
自身が処理手順を理解してVBAの初歩的な構造を理解すれば
作ってもらった3桁に達するであろうプロシージャの組み合わせでも容易だと思いますが・・・現状どうでしょうか私にはわかりません
No.6
- 回答日時:
長らく解決出来ないのは後から色々とご質問と違う所が出てくるところです
当該ご質問の部分を まとめ てみましたので 試してみてください
他に課題が生じた場合は別スレを立ててください
Sub 提出シートコピー削除2()
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
詳しく教えて頂きまして感謝いたします。
記者が教えて頂きましたこのコードでお願いしたいと思っております。
私を見捨てずに対応していただけまして感謝いたします。
後ほど改めて質問をさせて頂きます。
よろしくお願いいたします。
No.4
- 回答日時:
なんか出てきたけれど・・・しかも省略
別問題だと思うので
貼り付け処理でイベントが発生しない様に貼り付け実行前の
Application.DisplayAlerts = False
の上もしくは下に
Application.EnableEvents = False
を追加
Application.DisplayAlerts = True
の上もしくは下に
Application.EnableEvents = True
ちなみにApplication.DisplayAlertsって・・・
No.3
- 回答日時:
サブルーチンで処理を分けている場合、他の処理でも流用している可能性を考えてしまいます
よく見たら Sub 貼り付け()が抜けているだけで たぶん書いてありましたね
ならばWb1, Wb2をモジュールレベルにしてください はする必要は無いですかね
Sub 提出シートコピー範囲() と Sub 貼り付け()
Sub 提出シートコピー範囲()
Dim Wb2 As Workbook
Set Wb2 = Workbooks(2) '別ブック
'セルの値を取得する
Wb2.Worksheets("提出シート").Range("B1:H47").Copy
End Sub
Sub 貼り付け()
Dim Wb1 As Workbook
Set Wb1 = Workbooks(1) 'このブック
Application.DisplayAlerts = False
Wb1.Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.DisplayAlerts = True
End Sub
サブルーチンがこの目的のみであるならまとめた方がよさげ
試していないので合っているか不明
Sub 提出シートコピー削除()
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, ReadOnly:=True
Else
MsgBox "コピー元ファイルがありません", , "確認"
Exit Sub
End If
Dim Wb1 As Workbook, Wb2 As Workbook
Set Wb1 = Workbooks(1) 'このブック
Set Wb2 = Workbooks(2) '別ブック
'セルの値を取得する
Application.DisplayAlerts = False
Wb2.Worksheets("提出シート").Range("B1:H47").Copy _
Wb1.Worksheets("受付").Range("B1:H47").PasteSpecial(Paste:=xlPasteValuesAndNumberFormats)
With Wb2
If .Name Like "#########-#*" Then
If MsgBox(.Name & " を削除します", _
vbCritical + vbOKCancel, "警告!") = vbOK Then
Kill .FullName
.Close (False)
End If
End If
End With
Application.DisplayAlerts = True
End Sub
No.2
- 回答日時:
ご質問になかったけれど・・Sub 貼り付け() 後だしで追加されてもね
試しているわけではなく コードを読んでるだけなのでね
Sub 貼り付け()ではなく
Sub 提出シートコピー範囲() こっちの話
ちなみに 同じ処理が Sub 提出シートコピー範囲() にあるけれど
2度処理する意味がないと思うよ・・そちらはエラー大丈夫なの?
Call 提出シートを開く
Call 提出シートコピー範囲
Call 電子提出削除
End Sub
Sub 貼り付け()を処理しないで良くないですか・・
どうしても貼り付けを2度したいのなら
Sub 貼り付け()
Dim Wb1 As Workbook
Set Wb1 = ThisWorkbook
Application.DisplayAlerts = False
Wb1.Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.DisplayAlerts = True
End Sub
もしくは
Dim Wb1, Wb2 をモジュールレベルにしてください
って・・・意味わかりますか?
No.1
- 回答日時:
手動で行うとうまくいく VBAだとダメ・・・
おそらく ブック指定がされていないため
(手動だとアクティブにするからOK)
Wb2にWorksheets("受付")シートが無いのだと思いますので
Wb1.Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
として試してみて
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Excelのマクロについて教えてください。 2 2024/06/14 16:38
- Visual Basic(VBA) Excelのマクロについて教えてください。 1 2024/06/13 13:39
- Visual Basic(VBA) Excelのマクロについて教えてください。 1 2024/06/18 09:20
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/07/04 17:58
- Visual Basic(VBA) Excelのマクロについて教えてください。 1 2024/06/13 15:48
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2022/10/13 08:41
- Visual Basic(VBA) エクセルのマクロについて教えてください。 5 2023/06/02 08:44
- Excel(エクセル) 3つのマクロを連続実行の中で、1つ目のマクロ要件を満たさなかったら、マクロ2・3を実行しない為には 1 2023/10/15 13:42
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/05/24 08:33
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/08/03 12:30
このQ&Aを見た人はこんなQ&Aも見ています
-
性格の違いは生まれた順番で決まる?長男長女・中間子・末っ子・一人っ子の性格の傾向
同じ環境で生まれ育っても、生まれ順で性格は違うものなのだろうか。家庭教育研究家の田宮由美さんに教えてもらった。
-
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
VBAでCOPYを繰り返すと、処理が途中でアイドルする原因はなんでしょうか
Visual Basic(VBA)
-
-
4
エクセルのVBAコードについて教えてください。
Visual Basic(VBA)
-
5
Excelの数式について教えてください。
Excel(エクセル)
-
6
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
7
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
8
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
9
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
10
VBAコードについて教えてください。
Visual Basic(VBA)
-
11
エクセルに詳しい方教えて下さい! 以下の画像のデータ入力表の内容を運行日報平日に反映させたいです。
Excel(エクセル)
-
12
ExcelのVBAコードについて教えてください。
Visual Basic(VBA)
-
13
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
14
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
15
Excel VBA 定義されたプロージャ名、関数名の取得
Visual Basic(VBA)
-
16
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
17
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
18
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
19
数学 Tan(θ)-1/Cos(θ)について教えてください
Excel(エクセル)
-
20
エクセルのマクロについて教えてください。
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel・Word リサーチ機能を無...
-
特定のPCだけ動作しないVBAマク...
-
メッセージボックスのOKボタ...
-
エクセルで特定の列が0表示の場...
-
Excel マクロ VBA プロシー...
-
エクセルのマクロについて教え...
-
一つのTeratermのマクロで複数...
-
Excel VBAからAccessマクロを実...
-
Excelで特定の文字のところで自...
-
ExcelのVBA。public変数の値が...
-
TERA TERMを隠す方法
-
EXCELのVBAでRange("A1:C4")を...
-
VBAコードについて教えてくださ...
-
マクロの記録を使用したマクロ...
-
ExcelVBAでPDFを閉じるソース
-
プリプロセッサのエラー対策が...
-
特定文字のある行の前に空白行...
-
エクセルで別のセルにあるふり...
-
【EXCEL VBA】オートシェイプを...
-
オートフィルターとExcelマクロ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel・Word リサーチ機能を無...
-
特定のPCだけ動作しないVBAマク...
-
エクセルで特定の列が0表示の場...
-
Excel マクロ VBA プロシー...
-
メッセージボックスのOKボタ...
-
一つのTeratermのマクロで複数...
-
ExcelのVBA。public変数の値が...
-
Excel VBAからAccessマクロを実...
-
TERA TERMを隠す方法
-
ExcelVBAでPDFを閉じるソース
-
エクセルに張り付けた写真のフ...
-
EXCELのVBAでRange("A1:C4")を...
-
エクセルで別のセルにあるふり...
-
ソース内の行末に\\
-
マクロ実行時、ユーザーフォー...
-
特定文字のある行の前に空白行...
-
エクセルVBA
-
wordを起動した際に特定のペー...
-
マクロの記録を使用したマクロ...
-
ダブルクリックで貼り付けた画...
おすすめ情報
回答ありがとうございます。
教えて頂いたコードを設定しましたが、エラーメッセージ(「424」オブジェクトが必要です)が表示され、教えて頂いたコード自体が黄色くなり、マクロを実行できませんでした。
何度も申し訳ございません。
解決方法を教えてください。
よろしくお願いいたします。
変更したマクロ
Sub 貼り付け()
Application.DisplayAlerts = False
Wb1.Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.DisplayAlerts = True
SEnd Sub
以上となります。よろしくお願いいたします。
大変申し訳ありません、貼り付けのマクロを記載を忘れておりました。
教えて頂けたコードですが、
Sub 提出シートコピー範囲()
Dim Wb1, Wb2
Set Wb1 = Workbooks(1) 'このブック
Set Wb2 = Workbooks(2) '別ブック
'セルの値を取得する
Wb2.Worksheets("提出シート").Range("B1:H47").Copy
End Sub
のどの部分を修正すれば良いかを教えていただけますでしょうか。、
又、Dim Wb1, Wb2 をモジュールレベルにしてください
って・・・意味わかりますか?
ですが、やはり私には意味が理解できません。
何度も申し訳ありません、
よろしくお願いいたします。
Sub 提出シートコピー範囲()
Dim Wb1, Wb2
Set Wb1 = Workbooks(1) 'このブック
Set Wb2 = Workbooks(2) '別ブック
'セルの値を取得する
Wb2.Worksheets("提出シート").Range("B1:H47").Copy
Wb1.Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Subを設定出来ました。
貼り付けも貴者のコードに変更し、一連のマクロを実行しました処、コピー先に上手くコピーは出来たのですが、途中でエラーメッセージ(「9」インデックスが範囲内にありません)が表示されコピー先のシート名「受付」に設定しているVBAコードの「With Worksheets("審査")」が黄色くなっておりました。
VBAコードの全体は
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tbl As Variant
Dim i As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
tbl = Array("D10", "D11", "E10", "E11", "F10", "F11")
With Worksheets("審査")
For i = 0 To 5
.Range("C" & 26 + i).Value = Range(tbl(i)).Value
If Range(tbl(i)).Value = "" Then
.Range("F" & 26 + i).Value = ""
Else
.Range("F" & 26 + i).Value = "後日図書の提出をお願いいたします。"
End If
Next i
End With
On Error Resume Next
Sheets("消防添").Visible = [R37] = "消防添"
If Range("$D$2").Value = "電子申請" Then
Call 紙図
End If
If Range("$R$66").Value = "■" Then
Call 車庫増築
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
途中省略しておりますが、となっております。
この問題の解決方法を教えて頂けますか。
何度も申し訳ございません。よろしくお願いいたします。
回答ありがとうございます。詳しいコードも教えて頂きまして感謝いたします。教えて頂きました、マクロを実行しましたら、コピー元のファイルが開き、範囲指定も出来ており、又、コピー先のシートに範囲指定は出来ておりましたが、コピー先にコピーが出来ないままの画面になっており、コピー元のシートも削除出来ておりませんでした。何度も申し訳ございません。解決方法をよろしくお願いいたします。
ご連絡ありがとうございます。
Sub 貼り付け()
Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub
にするとエラーメッセージ(9)が表示されております。
試しにVBAコードの
Dim tbl As Variant
途中省略
End Withを全て削除して実行するとさすがにエラーは出ませんでしたが、コピー先にコピーも出来ましたが、その後の不要ファイルの削除が出来ませんでした。
私としては、出来れば一連のマクロを実行でお願いしたいと考えております、その後に今回削除したコードをシート名「審査」にVBAコードとして設定したいと思います。
いかがでしょうか。