Search

  毎日にもっと楽~を! BLOG Tokyo

2006年8月30日

【エクセル】複数のブックを一つにまとめる 1

同じ形式のファイルを一つのエクセルファイルにまとめて、データベースとして使う。あるいはアクセスにエクスポートなんてことをしたい場合もあります。

こんなときは、一つのワークシートにまとめちゃうマクロを作るのが便利です。
同一フォルダ内にtenkiフォルダを作成して、そこにまとめたいエクセルファイルを保存して、マクロを実行するだけ。楽勝です。

'---tenkiフォルダのすべてのブックを順番にひらいて転記する

Sub 複数のファイルを一つに()
Dim theName As String 'ブック名の保存用
Dim theDir As String 'パスの保存用
Dim theBook As Workbook '開いたブックの保存用
Dim flg As Boolean '1件目かどうかの識別用

flg = True
Application.ScreenUpdating = False

'現在のカレントパスのtenkiフォルダに移動する
theDir = ThisWorkbook.Path & "\tenki"
'(1) 拡張子xlsのファイル名を取り出す
theName = Dir(theDir & "\*.xls")

'(2) 最後のファイル名を取り出すまで繰り返す
Do While theName <> ""
'取り出したファイル名を指定してオープン
Set theBook = Workbooks.Open(theDir & "\" & theName)
'サブプロシージャへ
Call subTenki(theBook, flg)
flg = False
theBook.Close
theName = Dir
Loop
End Sub


'---開いたブックのアクティブセル領域をコピーする(サブプロシージャ)

Sub subTenki(theBook As Workbook, flg As Boolean)
Dim thetbl As Range, LRow As Long

Set thetbl = theBook.Sheets(1).Range("A1").CurrentRegion
'コピーする
thetbl.Copy

With ThisWorkbook.ActiveSheet
'(3) 転記先のシートのどの行までデータが入っているかを調べる
LRow = .Range("A65536").End(xlUp).Row

If LRow = 1 Then
.Range("A" & LRow).PasteSpecial xlPasteValues
Else
.Range("A" & LRow + 1).PasteSpecial xlPasteValues
End If
End With
Application.CutCopyMode = False
End Sub

【参考】
Excel VBA -逆引き大全- 555の極意
秀和システム 岡田和美著



Bookmark and Share


編集長のおすすめの一冊!2010

comments

comment form

(BLOG Tokyo にはじめてコメントされる場合、不適切なコメントを防止するため、掲載前に管理者が内容を確認しています。適切なコメントと判断した場合コメントは直ちに表示されますので、再度コメントを投稿する必要はありません。)

comment form