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

質問

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

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

回答No.4

n-jun · ベストアンサー

Close メソッド　ヘルプより
使用例
次の使用例は、Book1.xls のブックを閉じます。内容の変更は保存しません。

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

Workbooks.Close

回答No.3

n-jun

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

回答No.2

n-jun

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

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
こんな感じの事でしょうか？
ご参考まで。

補足

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

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

回答No.1

hallo-2007

過去の回答ですが
参考になりませんか？

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