エクセル マクロで別ブックから転記するやり方

エクセルでBook1(集計用)と、
店舗→Book2(大宮店)、Book3(東京店)・・・・・

何店舗もあるんですがそれぞれの店舗のA30,B30,C30,D30の数字を
Book1(集計用)のＡ列に並んだ店舗名のB列、C列、D列、E列に転記させたいと考えています。
今までは関数を入れて読み込ませていましたがこれをマクロで作成させる場合どのようにすればよいでしょうか？
何か他にいい案があれば教えていただきたいと思います。
よろしくお願いいたします。

No.4 ベストアンサー 回答者： n-jun 回答日時： 2008/07/17 13:43

Close メソッド　ヘルプより

使用例
次の使用例は、Book1.xls のブックを閉じます。内容の変更は保存しません。

Workbooks("BOOK1.XLS").Close SaveChanges:=False
次の使用例は、開かれているすべてのブックを閉じます。開かれているブックの内容が変更されている場合は、
確認のメッセージや、変更を保存するためのダイアログ ボックスが表示されます。

Workbooks.Close

No.3 回答者： n-jun 回答日時： 2008/07/17 06:53

ANo.2です。

>名前通りブックを読み取ることができずひとつ飛びになってしまったので何とか修正してみます。
　　　　　　　　　　End　With
　　　　　　　　　　i　=　i　+　1　'←削除
　　　　　　　End　If

>これから更に読み込むセルを指定したりすることは可能でしょうか？
Inputboxを調べてみる。（メソッドの方かな？）

この回答への補足

ありがとうございます。
下記のやり方が一番無難でしたがファイルを開きっぱなしにしてしまいます。
閉じるにはどの様に記述すればよいでしょうか？

Sub Bus()
Dim OurPath As String
OurPath = ThisWorkbook.Path & "C:\test\" '共通のPath
Workbooks.Open Filename:=OurPath & "Book2.xls" 'Book2を開く
ThisWorkbook.Sheets(1).Activate 'ThisWorkbookの1番目のSheetを選ぶ
'上記1番目のSheetのA1セルにBook2のSheet1のGセルの値を代入する
Range("A1").Value = Workbooks("Book2.xls").Sheets("Sheet1").Range("G7")
End Sub

補足日時：2008/07/17 12:59

No.2 回答者： n-jun 回答日時： 2008/07/16 21:13

詳細がよく分かりませんが。

Sub　sample()
　　　　　Dim　myObj　As　Object
　　　　　Dim　ws　As　Worksheet
　　　　　Dim　fn　As　String,　Fp　As　String
　　　　　Dim　i　As　Long,　j　As　Integer

　Application.ScreenUpdating　=　False

　Set　myObj　=　CreateObject("Shell.Application").　_
　BrowseForFolder(0,　"フォルダを選択してください",　0)

　If　myObj　Is　Nothing　Then　Exit　Sub

　Set　ws　=　ActiveSheet　'アクティブなシート
　Fp　=　myObj.Items.Item.Path　&　"\"　　'保存場所のパス
　fn　=　Dir(Fp　&　"*.xls",　0)
　
　With　ws
　　　　　　.Range("A1").Value　=　"Book名"
　　　　　　.Range("B1").Value　=　"項目１"
　　　　　　.Range("C1").Value　=　"項目２"
　　　　　　.Range("D1").Value　=　"項目３"
　　　　　　.Range("E1").Value　=　"項目４"
　End　With
　i　=　2

　　　　Do　Until　fn　=　""
　　　　
　　　　　　　If　fn　<>　ThisWorkbook.Name　Then
　　　　　　　　　　Cells(i,　"A").Value　=　fn
　　　　
　　　　　　　　　　With　Application.Workbooks.Open(Fp　&　fn)
　　　　　　　　　　　　　　　ws.Cells(i,　"B").Resize(,　4).Value　=　_
　　　　　　　　　　　　　　　.Worksheets(1).Range("A30").Resize(,　4).Value
　　　　　　　　　　　　　　　i　=　i　+　1
　　　　　　　　　　　　　　　.Close　SaveChanges:=False
　　　　　　　　　　End　With
　　　　　　　　　　i　=　i　+　1
　　　　　　　End　If
　　　　　　　fn　=　Dir()
　　　　Loop
　Application.ScreenUpdating　=　True
End　Sub
こんな感じの事でしょうか？
ご参考まで。

この回答への補足

早速にご回答誠にありがとうございます。
名前通りブックを読み取ることができずひとつ飛びになってしまったので何とか修正してみます。

これから更に読み込むセルを指定したりすることは可能でしょうか？
色々探してはいますがなかなか見つかりません。
なんとか探してみます。

補足日時：2008/07/17 03:24

No.1 回答者： hallo-2007 回答日時： 2008/07/16 20:57

過去の回答ですが

参考になりませんか？

http://oshiete1.goo.ne.jp/qa4134321.html

この回答への補足

ありがとうございます。
下記のやり方が一番無難でしたがファイルを開きっぱなしにしてしまいます。
閉じるにはどの様に記述すればよいでしょうか？


Sub Bus()
Dim OurPath As String
OurPath = ThisWorkbook.Path & "C:\test\" '共通のPath
Workbooks.Open Filename:=OurPath & "Book2.xls" 'Book2を開く
ThisWorkbook.Sheets(1).Activate 'ThisWorkbookの1番目のSheetを選ぶ
'上記1番目のSheetのA1セルにBook2のSheet1のGセルの値を代入する
Range("A1").Value = Workbooks("Book2.xls").Sheets("Sheet1").Range("G7")
End Sub

補足日時：2008/07/17 13:02