|
ファイルA,sheet("リスト"),range("G33","H15","I18")
ファイルB,sheet("リスト"),range("G33","H15","I18")
ファイルC,sheet("リスト"),range("G33","H15","I18")
ファイルD,sheet("リスト"),range("G33","H15","I18")
↓↓↓
[ファイルX]
A B C
1 ファイルAのG33値,ファイルAのH15値,ファイルAのI18値
2 ファイルBのG33値,ファイルBのH15値,ファイルBのI18値
3 ファイルCのG33値,ファイルCのH15値,ファイルCのI18値
4 ファイルDのG33値,ファイルDのH15値,ファイルDのI18値
ファイルA〜Dの4ファイルから3つのセル値を抽出し、ファイルXという新しいブックにまとめて転記したいのですが、下記の型を4回書く方法しかできませんでした。(ファイルA〜Dの中のひとつファイルAを書いてみましたが・・・)これをひとつのSubにまとめることはできるのでしょうか?教えてください。よろしくお願いします。
Sub 転記する()
Dim ブック as Workbook
Application.EnableAEvents=False
Set ブック =Workbooks.Open(ファイルA)
ThisWorkbook.Worksheets(1).Range("A1")=_
ブック.Worksheets("リスト").Range("G33").Value
ThisWorkbook.Worksheets(1).Range("B1")=_
ブック.Worksheets("リスト").Range("H15").Value
ThisWorkbook.Worksheets(1).Range("C1")=_
ブック.Worksheets("リスト").Range("I18").Value
Application.EnableEvents=True
End Sub
|
|