Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7467 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【38943】転記について教えてください！ ESMEY 06/6/14(水) 23:42 質問[未読]
【38944】Re:転記について教えてください！ かみちゃん 06/6/14(水) 23:49 発言[未読]
【38946】Re:転記について教えてください！ T 06/6/15(木) 6:53 発言[未読]
【39012】Re:転記について教えてください！ ESMEY 06/6/15(木) 22:21 お礼[未読]
【38943】転記について教えてください！
質問  ESMEY  - 06/6/14(水) 23:42 -
引用なし
パスワード
   ファイル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という新しいブックにまとめて転記したいのですが、下記の型を４回書く方法しかできませんでした。(ファイル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
【38944】Re:転記について教えてください！
発言  かみちゃん  - 06/6/14(水) 23:49 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>ファイルA〜Dの4ファイルから3つのセル値を抽出し、ファイルXという新しいブックにまとめて転記したいのですが、下記の型を４回書く方法しかできませんでした。(ファイルA〜Dの中のひとつファイルAを書いてみましたが・・・)これをひとつのSubにまとめることはできるのでしょうか？

以下のようなコードが、ちょっとしたヒントになりますでしょうか？

Sub Test()
　Dim i As Integer
　Dim strBookName As Variant
　
　strBookName = Array("A", "B", "C", "D")
　For i = 0 To UBound(strBookName)
　　MsgBox "ブック" & strBookName(i) & " を処理します"
　Next
　MsgBox "終了"
End Sub
【38946】Re:転記について教えてください！
発言  T  - 06/6/15(木) 6:53 -
引用なし
パスワード
   ▼ESMEY さん：

これが使えます。いま小生が使っているコードです。
アレンジしてください。

Sub test3()

'Application.ScreenUpdating = False
Dim BK(1 To 5) As Workbook
Dim i　 As Integer

Set BK(1) = Workbooks.Open(ThisWorkbook.Path & "\Book1.xls")
Set BK(2) = Workbooks.Open(ThisWorkbook.Path & "\Book2.xls")
Set BK(3) = Workbooks.Open(ThisWorkbook.Path & "\Book3.xls")
Set BK(4) = Workbooks.Open(ThisWorkbook.Path & "\Book4.xls")
Set BK(5) = Workbooks.Open(ThisWorkbook.Path & "\Book5.xls")

For i = 1 To UBound(BK, 1)
With ThisWorkbook.Sheets(1)
　　.Range(.Cells(5, i + 1), .Cells(24, i + 1)).Value = _
　　　BK(i).Sheets(1). _
　　　 Range(BK(i).Sheets(1).Cells(2, i), BK(i).Sheets(1).Cells(21, i)).Value
Next i
　
For i = 1 To 5
　　BK(i).Close False: Set BK(i) = Nothing　Next i
'Application.ScreenUpdating = True
End Sub
【39012】Re:転記について教えてください！
お礼  ESMEY  - 06/6/15(木) 22:21 -
引用なし
パスワード
   かみちゃんさん！小生さん！
ありがとうございました！
すっきりしました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7467 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free