人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルVBAの質問です。
あるフォルダにあるすべてのブックを、ひとつのブックにシートとしてまとめるにはどのような方法がありますか。
まとめられたブックの各シートが、もともとのブックといったイメージです。
よろしくお願いいたします。

●質問者: clinejp
●カテゴリ:コンピュータ インターネット
✍キーワード:VBA ひとつ イメージ エクセル フォルダ
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● freemann
●35ポイント

ThisWorkbookのところに以下のVBAを書きます。

なお、clinejpさんのエクセルのバージョンが分からないのですが2007でも動くものにしました。

http://q.hatena.ne.jp/1211998240

Public Sub CopyAllSheets()

Dim strPath As String

Dim index As Integer

Dim strFName As String

strPath = Application.GetOpenFilename

If strPath = "False" Then

Exit Sub

End If

index = InStrRev(strPath, "\")

strPath = Left(strPath, index)

strFName = Dir(strPath & "*.xls*") 'ここで拡張子が2007タイプでも読み込むようになっています。

Do While strFName <> ""

CopySheetsInBook (strFName)

strFName = Dir()

Loop

End Sub

Private Sub CopySheetsInBook(strFName As String)

Dim NumOfSheets As Integer

Dim iSheets As Worksheet

NumOfSheets = Workbooks(1).Sheets.Count

Workbooks.Open strFName

With Workbooks(2)

For Each iSheets In .Sheets

iSheets.Copy after:=Workbooks(1).Worksheets(NumOfSheets)

NumOfSheets = NumOfSheets + 1

Next

.Saved = True

.Close

End With

End Sub

◎質問者からの返答

大変参考になりました。

エクセル2002ですが動きましたありがとうございます。


2 ● SALINGER
●35ポイント

指定されたフォルダのブックの最初のシートを一つのブックにまとめるマクロです。

Sub Macro()
  'フォルダのパスを指定してください
 Const foldPath As String = "C:\Documents and Settings\hogehoge\デスクトップ\test"
 Dim Filename As String
 Dim wb As Workbook
 
 Filename = Dir(foldPath & "\*.xls", vbNormal)
 Do While Filename <> ""
 Set wb = Workbooks.Open(foldPath & "\" & Filename)
 wb.Worksheets(1).Copy before:=ThisWorkbook.Sheets(1)
 ThisWorkbook.Worksheets(1).Name = Left(Filename, Len(Filename) - 4)
 wb.Close
 Filename = Dir()
 Loop
End Sub

http://q.hatena.ne.jp/

◎質問者からの返答

動きました。

ありがとうございます!

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ