[[20161020140328]]　『3つのブックのデータを一枚のシートに蓄積』（かっぱ）　ページの最後に飛ぶ

『3つのブックのデータを一枚のシートに蓄積』（かっぱ）

ＶＢＡについての質問です。

表題の通り、３つのブック（ブックＡ・ブックＢ・ブックＣ）の集計シートのデータを一つのブック（集計ブック、集計シート）に蓄積したいです。
3つのブックのタイトル行は同じで、Ａ列～Ｋ列まであります。

3つのブックのファイルパスは集計ブックのsheet2のA1～A3（A1：ブックA　A2：ブックB　A3:ブックC）に記入してあります。
そのファイルパスをみて、各ブックのA2～K最終行までのデータを集計ブック・集計シートのA2から記入したいです。

また、こちらの集計ブックは複数回使用するので、２回目以降は前回集計したデータをいったん削除してから新たにA2～記入ということを行いたいです。

このようなことを行うことは可能でしょうか？
よろしくお願いいたします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

Sub main()
'集計ブックの標準モジュール
'シート名はそれぞれ「集計」

    Dim c As Range
    ThisWorkbook.Sheets("集計").Range("A2:K" & Rows.Count).ClearContents
    For Each c In ThisWorkbook.Sheets("Sheet2").Range("A1:A3")
        With Workbooks.Open(Filename:=c.Value, ReadOnly:=True)
        Range(.Sheets("集計").Range("A2"), .Sheets("集計").Range("k" & Rows.Count).End(xlUp)).Copy ThisWorkbook.Sheets("集計").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .Close
        End With
    Next c
End Sub

（mm） 2016/10/20(木) 15:38

ｍｍさんご回答ありがとうございます。

いただいたマクロを試してみたのですが、ブックのオープンまではきちんと行えるのですが、ブックを開くと
「エラー　400」と出てしまいました。
コードの部分が黄色くなるのではなくウインドウ？で「エラー　400」と出ます。

原因となる要素がわからない状況です。

よろしくお願いいたします。
（かっぱ） 2016/10/20(木) 15:51

これでいかがですか
Sub main()
'集計ブックの標準モジュール、シート名はそれぞれ「集計」

    Dim c As Range, wb As Workbook
    ThisWorkbook.Sheets("集計").Range("A2:K" & Rows.Count).ClearContents
    For Each c In ThisWorkbook.Sheets("Sheet2").Range("A1:A3")
        Set wb = Workbooks.Open(Filename:=c.Value, ReadOnly:=True)
        wb.Sheets("集計").Range(wb.Sheets("集計").Range("A2"), wb.Sheets("集計").Range("k" & Rows.Count).End(xlUp)).Copy ThisWorkbook.Sheets("集計").Range("A" & Rows.Count).End(xlUp).Offset(1)
        wb.Close
    Next c
End Sub
（mm） 2016/10/20(木) 16:17

ｍｍさんご回答ありがとうございます。

新たにいただいたマクロで求めていた動きができました。
ありがとうございます。
（かっぱ） 2016/10/20(木) 16:30

申し訳ありません、追記です。

いただいたマクロを試していたのですが、A列～K列全てに記入のあるものはきちんと取得してくれるのですが、
A列～K列の中で空白行がある部分を取得してくれませんでした。

こちらはすべての行に記入がないと取得できないのでしょうか？

よろしくお願いいたします。
（かっぱ） 2016/10/20(木) 16:44

'これではいかがですか
Sub main()
'集計ブックの標準モジュール、シート名はそれぞれ「集計」

    Dim c As Range, rg As Range, wb As Workbook
    ThisWorkbook.Sheets("集計").Range("A2:K" & Rows.Count).ClearContents
    For Each c In ThisWorkbook.Sheets("Sheet2").Range("A1:A3")
        Set wb = Workbooks.Open(Filename:=c.Value, ReadOnly:=True)
        Set rg = Intersect(wb.Sheets("集計").UsedRange.EntireRow, wb.Sheets("集計").Columns("A:K"))
        wb.Sheets("集計").Range(wb.Sheets("集計").Range("A2"), rg.Resize(1, 1).Offset(rg.Rows.Count - 1, rg.Columns.Count - 1)).Copy ThisWorkbook.Sheets("集計").Range("A" & Rows.Count).End(xlUp).Offset(1)
        wb.Close
    Next c

（mm） 2016/10/20(木) 17:21

 既出のものとあまり変わりませんが。

 Sub Sample()
    Dim c As Range
    Dim shT As Worksheet

    Application.ScreenUpdating = False

    Set shT = ThisWorkbook.Sheets("集計")
    shT.UsedRange.Offset(1).ClearContents
    For Each c In ThisWorkbook.Sheets("Sheet2").Range("A1:A3")
        With Workbooks.Open(c.Value, ReadOnly:=True).Sheets("集計")
            .UsedRange.Offset(1).Copy shT.Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Parent.Close False
        End With
    Next

 End Sub

（β） 2016/10/20(木) 19:48

コメント返信：

[ 一覧(最新更新順) ]

[[20161020140328]] 『3つのブックのデータを一枚のシートに蓄積』（かっぱ） ページの最後に飛ぶ

[[20161020140328]]　『3つのブックのデータを一枚のシートに蓄積』（かっぱ）　ページの最後に飛ぶ