|
5個のブックのシート1と2からセルのデータを
一枚の「仕上げシート」に貼り付けたいのですが・・・
これに関して2点質問があります。
1.もう少しシンプルなコードに仕上げたい
2.複数のセルデータの貼りこみの仕方(コードの中の⇒です)が上手く行きません
対応の方法
この2件について教えてください。
現在のコードは
Dim 一枚仕上げ As Workbook
Dim A111 As Workbook
Dim A222 As Workbook
Dim A333 As Workbook
Dim A444 As Workbook
Dim A555 As Workbook
On Error Resume Next
Set 一枚仕上げ = ThisWorkbook
Set A111 = Workbooks.Open(ThisWorkbook.Path & "\A111.xls")
Set A222 = Workbooks.Open(ThisWorkbook.Path & "\A222.xls")
Set A333 = Workbooks.Open(ThisWorkbook.Path & "\A333.xls")
Set A444 = Workbooks.Open(ThisWorkbook.Path & "\A444.xls")
Set A555 = Workbooks.Open(ThisWorkbook.Path & "\A555.xls")
With 一枚仕上げ.Sheets(1)
.Range("B5").Value = A111.Sheets(1).Range("A1:B1")
'質問2.⇒上の行B5にBookA111のRange("A1:B1")を貼り付ける方法
'下の4行も複数のセルデータをB列に貼り付けたいのですが、現在は出来ていません。
.Range("B6").Value = A222.Sheets(1).Range("A1")
.Range("B7").Value = A333.Sheets(1).Range("A1")
.Range("B8").Value = A444.Sheets(1).Range("A1")
.Range("B9").Value = A555.Sheets(1).Range("A1")
.Range("D5").Value = A111.Sheets(2).Range("A1")
.Range("D6").Value = A222.Sheets(2).Range("A1")
.Range("D7").Value = A333.Sheets(2).Range("A1")
.Range("D8").Value = A444.Sheets(2).Range("A1")
.Range("D9").Value = A555.Sheets(2).Range("A1")
End With
A111.Close False
A222.Close False
A333.Close False
A444.Close False
A555.Close False
Set A111 = Nothing
Set A222 = Nothing
Set A333 = Nothing
Set A444 = Nothing
Set A555 = Nothing
On Error GoTo 0
以上です。宜しくお願いします。
|
|