フォルダ内のブック全ての同じ位置に貼り付け

質問

ある範囲に計算式の入ったセルをコピーして、一つのフォルダに入った全てのExcelブックの同じ位置に貼り付けるという処理をマクロで行いたいのですが、貼り付けるだけでできるようなコードを教えていただけないでしょうか？

回答No.3

HohoPapa · ベストアンサー

>一つのフォルダに入った全てのExcelブック
このフォルダーには、
複写を行うマクロブック、複写元のブック、複写先ブック以外は
配置されていないという前提でよければ、
次のようなコードで行けるんじゃないかと思います。
※極単純なテストしかしていません　ｍ(_ _)ｍ

Option Explicit

Const FromBookName = "ブックA.xlsx"
Const FromRow = 1 '複写開始行番号
Const FromCol = 1　'複写開始列番号
Const CopyRows = 5　'複写行数
Const CopyCols = 4　'複写列数
Const CopyShNum = 1 '複写対象シート番号

'//-------------------------------------------------
Sub Main()

　Dim buf As String
　Dim MyPath As String
　Dim FBook As Workbook
　Dim TBook As Workbook

　Set FBook = Workbooks.Open(ThisWorkbook.Path & "\" & FromBookName)
　MyPath = ThisWorkbook.Path & "\"
　buf = Dir(MyPath & "*.*")
　Do While buf <> ""
　　If ((buf <> ThisWorkbook.Name) And (buf <> FromBookName)) Then
　　　Set TBook = Workbooks.Open(ThisWorkbook.Path & "\" & buf)
　　　cellscopy FBook, TBook
　　　Application.DisplayAlerts = False
　　　TBook.Save
　　　Application.DisplayAlerts = True
　　　TBook.Close
　　End If
　　buf = Dir()
　Loop
　FBook.Close
End Sub

'//-------------------------------------------------
Sub cellscopy(FBook As Workbook, TBook As Workbook)
　Dim CopyRange As Range

　With FBook.Sheets(CopyShNum)
　　Set CopyRange = _
　　　Range(.Cells(FromRow, FromCol), _
　　　.Cells(FromRow + CopyRows - 1, FromCol + CopyCols - 1))
　　CopyRange.Copy TBook.Sheets(CopyShNum).Cells(FromRow, FromCol)
　End With

End Sub

お礼

今日試させていただきました。
完璧です！ありがとうございました。
さらっとこれほどの事ができるなんて、羨ましい限りです。私も勉強していきたいと思います。本当にありがとうございました。

補足

ありがとうございます！
事情があって今日は試すことができなかったので、また明日返信させていただきます。
今の私にはほとんど理解できないコードですが、少しでも理解できるようになりたいです。

回答No.2

kon555

参考になりそうなページをどうぞ
https://tonari-it.com/for-each-next/

ちなみに1つのフォルダに入ったブック全て、というコードよりも、一手間かかっても作業者が「指定」する方が実務的には使いやすいのでお勧めです。

多少解説しておくと、複数の対象物に対して同じ処理を繰り返す場合、大抵はFor Each ～next構文を用います。
今回も「複数のブックの同じ位置に貼り付ける」という「同じ処理」なのでFor Eachで処理できます。

使えると便利な構文なので、この機会に覚えてしまいましょう。

お礼

ありがとうございます。勉強して少しでもマスターしたいと思います！

回答No.1

imogasi

意味がつかめない。
ブックA,B,C、D・・が同じフォルダにあると仮定して、
ブックAの例えばSheet1のＡ1:D5のセル範囲を、（同じフォルダー内の）ブックB.C,D・・の、各Ｓｈｅｅｔ１のセル範囲のA1:D5に貼り付けしたいということか。
シートＳｈｅｅｔ１以外の参照をしている式は、ブックＡのＳｈｅｅｔ１のＡ１：Ｄ５で、存在しないのか？
ーー
ＶＢＡを用いて、あるフォルダの中のブック（ファイル）を捕まえるコードは、ＷＥＢにたくさん出ている（有名なテーマ）。Ｇｏｏｇｌｅなどで調べて、自分なりに、微修正すればよい。回答者に頼む前に調べてみること。

補足

推察していただいた通り、
ブックAの例えばSheet1のＡ1:D5のセル範囲を、（同じフォルダー内の）ブックB.C,D・・の、各Ｓｈｅｅｔ１のセル範囲のA1:D5に貼り付けしたい。
式は、ブックＡのＳｈｅｅｔ１のＡ１：Ｄ５にあり、式ごと貼り付けしたいのです。
検索して見つけたコードを微修正してみたのですが、フォルダ内のひとつのブックにしか貼り付けできなくて・・
お力いただければと思うのですが・・・