VBA 同じフォルダ内のすべてのファイルに同じセルをペーストしたい

VBAについてのご質問です。

”データ処理ファイル”というファイルの”データ処理シート”というシートの”B1:S110000”セルをコピーして
同じフォルダ内のすべてのファイルの”あ”というシートの”B1:S110000”セルにペーストしたいです。

自分なりに下記のように作ってみましたが一部でエラーが出てしまいうまく動作しません。
お手数をおかけしますが、どのように修正すればよいかご教示いただけますでしょうか。
また、全然違うようでしたらサンプルコードをいただけないでしょうか？

差し出がましい質問で大変恐縮ですが、ご教示いただけると幸いです。

Sub 粗さデータ処理()
Dim fileName As String
Dim wsName As String: wsName = "粗さデータ" '対象ワークシート名

Application.ScreenUpdating = False '各ファイルの変更処理を表示させない
Application.DisplayAlerts = False '保存時メッセージを表示させない
ChDir ThisWorkbook.Path
fileName = Dir("*.xlsx?") 'フォルダ内の最初のエクセルファイル名を取得
Do While fileName <> ""
If fileName <> ThisWorkbook.Name Then 'マクロのあるファイルでなければ
With Workbooks.Open(fileName) 'ファイルオープン
ThisWorkbook.Worksheets("粗さデータ処理シート").Range("B1:S110000").Copy_
.Worksheets(wsName).Range("B1").Select
.Close savechanges:=True '保存＆クローズ
End With
End If
fileName = Dir() 'フォルダ内の次のエクセルファイル名を取得
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


ThisWorkbook.Worksheets("粗さデータ処理シート").Range("B1:S110000").Copy_でエラーが出ています。

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

• ご回答本当にありがとうございます。
  ご指摘いただいたとおりに修正したところ、エラーは出ませんが処理が行われない状態となってしまいました。
  度々申し訳ございませんが、このような場合はどのように対処すればよろしいでしょうか？
  よろしくお願いいたします。

    補足日時：2024/12/17 14:36

No.3 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/12/17 15:11

もし、Cドライブ上にない場合は、ChDirを使用しない方法のほうが良いです。

かなり書き換えますが、以下のようにしてください。
これから、外出します。戻りは、夕方以降になります。


Sub 粗さデータ処理()
Dim fileName As String
Dim filePath As String
Dim wsName As String: wsName = "粗さデータ" '対象ワークシート名

Application.ScreenUpdating = False '各ファイルの変更処理を表示させない
Application.DisplayAlerts = False '保存時メッセージを表示させない
filePath = ThisWorkbook.path
fileName = Dir(filePath & "\" & "*.xls?") 'フォルダ内の最初のエクセルファイル名を取得
Do While fileName <> ""
If fileName <> ThisWorkbook.Name Then 'マクロのあるファイルでなければ
With Workbooks.Open(filePath & "\" & fileName) 'ファイルオープン
ThisWorkbook.Worksheets("粗さデータ処理シート").Range("B1:S110000").Copy .Worksheets(wsName).Range("B1")
.Close savechanges:=True '保存＆クローズ
End With
End If
fileName = Dir() 'フォルダ内の次のエクセルファイル名を取得
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

この回答へのお礼

本当にありがとうございます！
ファイルがCドライブ上になかったみたいでした。新しくいただいたコードで動作できました。
丁寧で迅速な対応をしていただき本当にありがとうございます。

お礼日時：2024/12/17 17:02

No.2 回答者： tatsumaru77 回答日時： 2024/12/17 14:53

>処理が行われない状態となってしまいました。

コピー先に、コピーされないということでしょうか？
With Workbooks.Open(fileName) 'ファイルオープン
の行にブレイクポイントを設定し、実行したとき、そこで止まると思いますが、そのあと、1ステップずつ実行して、期待した動作をするか、確認してください。
また、ブレイクポイントで、止まった時、fileNameにマウスをあてると、ファイル名が表示されます。そのファイル名が、期待した結果であることを確認してください。

一点、気になるのは、マクロを格納したブックが、Cドライブであれば、問題ありませんが、Cドライブでない場合、
ChDir ThisWorkbook.Path
は、マクロを格納したフォルダに移動してくれません。
マクロを格納したブックは、Cドライブ上にありますか。

No.1 回答者： tatsumaru77 回答日時： 2024/12/17 08:31

ThisWorkbook.Worksheets("粗さデータ処理シート").Range("B1:S110000").Copy_

.Worksheets(wsName).Range("B1").Select
の2行を
ThisWorkbook.Worksheets("粗さデータ処理シート").Range("B1:S110000").Copy _
Destination:=.Worksheets(wsName).Range("B1")

にしてください。
Copyの後に空白を１つ入れてから継続の_を入れます。
継続行を指定した場合、２行目は、Destination:=を指定しないとエラーになるようです。

１行で、
ThisWorkbook.Worksheets("粗さデータ処理シート").Range("B1:S110000").Copy .Worksheets(wsName).Range("B1")
と書いてもOKです。