[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『3つのブックのデータを一枚のシートに蓄積』(かっぱ)
VBAについての質問です。
表題の通り、3つのブック(ブックA・ブックB・ブックC)の集計シートのデータを一つのブック(集計ブック、集計シート)に蓄積したいです。
3つのブックのタイトル行は同じで、A列〜K列まであります。
3つのブックのファイルパスは集計ブックのsheet2のA1〜A3(A1:ブックA A2:ブックB A3:ブックC)に記入してあります。
そのファイルパスをみて、各ブックのA2〜K最終行までのデータを集計ブック・集計シートのA2から記入したいです。
また、こちらの集計ブックは複数回使用するので、2回目以降は前回集計したデータをいったん削除してから新たにA2〜記入ということを行いたいです。
このようなことを行うことは可能でしょうか?
よろしくお願いいたします。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
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
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
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.