こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

excel 他ブックからセルを範囲で取得する方法

Abook.xlsx、B1book.xlsx、B2book.xlsx、B3book.xlsxというファイルがあります。
B1book~B3bookは同じフォーマットになりますが、Bbookのセル範囲(A1:C7)を
Abookの「集計シート」にセットしたいのですが、コードでの記述をご教授
頂けませんでしょうか。

Abookのイメージ
   A      B ・・・・・・H
 1 B1book.xlsx  A1・・・・・・A7
 2         B1・・・・・・B7
 3         C1・・・・・・C7
 4 B2book.xlsx  A1・・・・・・A7
 5         B1・・・・・・B7
 6         C1・・・・・・C7
 7 B3book.xlsx  A1・・・・・・A7
 8         B1・・・・・・B7
 9         C1・・・・・・C8
このようなイメージになります。
よろしくお願いします。

投稿日時 - 2019-12-05 20:25:59

QNo.9686690

困ってます

質問者が選んだベストアンサー

>B1~B3を開かずにできたらと思っていたのですが、可能でしょうか。
bkPath にBブックの場所を指定してください。

Sub BookCopy2()
 Dim f As Integer
 
 Application.ScreenUpdating = False
 For f = 1 To 3
  Call BookCopuSub2(f)
 Next
 Range("A1").Select
 Application.ScreenUpdating = True
End Sub

 Sub BookCopuSub2(f As Integer)
  Const bkPath = "N:\*******\" '// Bブックの場所を指定
  Dim bkName As String
  bkName = "B" & f & "book.xlsx"
  
  Workbooks.Open bkPath & bkName
  Sheets("Sheet1").Select
  Range("A1:C7").Select
  Selection.Copy
  
  Windows("ABook2.xlsm").Activate
  With Range("A1")
   .Offset((f - 1) * 3, 0) = "B" & f & "book.xlsx"
   .Offset((f - 1) * 3, 1).Select
   Selection.PasteSpecial Paste:=xlPasteAll, _
     Operation:=xlNone, SkipBlanks:= _
     False, Transpose:=True
  End With
 
  Application.DisplayAlerts = False
  Workbooks(bkName).Close
  Application.DisplayAlerts = True
 End Sub

投稿日時 - 2019-12-06 13:00:29

お礼

早々にご回答頂き、ありがとうございます。
早速やってみようと思います。
本当にありがとうございました。

投稿日時 - 2019-12-06 13:04:25

ANo.4

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

>他ブックからセルを範囲で取得する方法
セルの表記をブックから正確に記述すると
 Workbooks(ブック名).Worksheets(シート名).Range(セル範囲)
になります。

なので、既に開いている[B1book.xlsx]ブックの[Sheet1]シートの[A1:C7]セル範囲は
 Workbooks("B1book.xlsx").Worksheets("Sheet1").Range("A1:C7")
で取得できます。
(開いていないブックのデータを取得するのは、どのフォルダに存在するファイルか、から指定しないといけないので、難易度が結構上がります)

これが分かっていれば、後は力業でも何とかできます。


・作業するブックは全て開いている。
・コピーするセル、貼り付けるセルは全てSheet1である。
・セル自体をコピーする(値だけでなく、文字色等の書式も含める)。
という前提で組んでみました。
値だけをコピーしたい場合は、コピー部分のコメントアウトを切り替えて下さい。


Sub CopyOtherBooks()
 Dim i As Long
 Dim myBK As Workbook 'ループ用
 Dim aryBooks As Variant 'データを取得するブック名。
 Dim rangeCopy As Range 'コピーするセル範囲
 Dim cellPaste As Range '貼り付ける基準セル。

 'コピーするブック名一式を設定
 aryBooks = Array("B1Book.xlsx", "B2Book.xlsx", "B3Book.xlsx")
 '貼り付ける範囲の左上のセルを設定。
 Set cellPaste = Workbooks("ABook.xlsm").Worksheets("Sheet1").Range("A1")

 For Each myBK In Workbooks
  For i = LBound(aryBooks) To UBound(aryBooks)
   If myBK.Name = aryBooks(i) Then
    'そのブックのコピーする範囲を設定。
    Set rangeCopy = myBK.Worksheets("Sheet1").Range("A1:C7")
    '貼り付け。
    rangeCopy.Copy cellPaste
'    '値だけを貼り付け
'    cellPaste.Resize(rangeCopy.Rows.Count, rangeCopy.Columns.Count).Value = rangeCopy.Value
    '貼り付ける範囲を下にずらす。
    Set cellPaste = cellPaste.Offset(rangeCopy.Rows.Count, 0)
   End If
  Next i
 Next myBK
End Sub

投稿日時 - 2019-12-06 10:37:59

お礼

丁寧に記述頂きありがとうございます。
コメントも入れて頂き非常に分かりやすく助かります。
この方法でも試してみようかと思います。
本当にありがとうございました。

投稿日時 - 2019-12-06 15:52:50

ANo.2

B1book~B3bookの3ブックは開いているものとして書いています。また、いずれもSheet1にあるとしています。
閉じている前提ならば補足してください。修正します。
ブック名やセル範囲は質問にあるとおりにしています。

Abook.xlsxはマクロを含むので、Abook.xlsmになります。
当方、Win10、Excel2010です。

Sub BookCopy()
 Dim f As Integer
 For f = 1 To 3
  Call BookCopuSub(f)
 Next
 Range("A1").Select
End Sub

 Sub BookCopuSub(f As Integer)
   Windows("B" & f & "book.xlsx").Activate
   Sheets("Sheet1").Select
   Range("A1:C7").Select
   Selection.Copy
   
   Windows("ABook.xlsm").Activate
   With Range("A1")
    .Offset((f - 1) * 3, 0) = "B" & f & "book.xlsx"
    .Offset((f - 1) * 3, 1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, _
      Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=True
   End With
 End Sub

投稿日時 - 2019-12-05 23:17:05

補足

丁寧に回答頂き本当にありがとうございます。大変助かります。
B1~B3を開かずにできたらと思っていたのですが、可能でしょうか。
もしお時間があればご教授頂けませんでしょうか。
よろしくお願いします。

投稿日時 - 2019-12-06 09:42:01

ANo.1

質問の説明が、ぴんと来なくて、課題がよくわからない。
シート画像でも張り付けては、どうだろう。
個別のセルの値を記述しても、イメージがわきにくいし、値そのものは、処理に
関係ないだろう。書き方が質問者の我流でわかりにくい。
ーー
まず思ったのは、必要なスキルは
・コピー貼り付けをすればよい。
・CurrentRegionが使えないか。(コピー元で)
・見出し行を貼り付け対象から除きたいなら、Resizeを使う。
・他ブックへの処理は、
http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_070_11.html
シートやブックを越えたRangeオブジェクト取得
などを参考に。
Googleで「Excel VBA 他ブック参照」などで照会。
・Aブックに累積したいなら、張り付けるとき、そのつど、最終行の次行
lr=(Aブック・シート名).Range("A100000").End(xlUp).Row +1
のようなのが使えないか。
・Bブックの数だけ繰り返す。
など浮かんだが。

投稿日時 - 2019-12-05 21:44:07

お礼

ありがとうございます。
質問分かりにくかったでしょうか。すみませんでした。
教えて頂いた内容も検討してみたいと思います。

投稿日時 - 2019-12-06 09:38:09

あなたにオススメの質問