[[20050210100639]] 『複数のファイルを1つのファイルに集約』(香織) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数のファイルを1つのファイルに集約』(香織)

『20050210』というフォルダの中に、中にあるファイルの中のシート全てを、『総合.xls』というファイルにまとめたいのですが、どうしたらいいか教えていただけますか?
まとめる際のマクロは『総合.xls』に記載したいのですが可能ですか?


 可能です。
ただし考慮すべき点があります。
各ブックに含まれるシート名には、重複の可能性があるのではないか、と言う点です。
その場合にどのような命名規則を用いるかを定めたほうがよさそうです。
例として、ファイル名&シート名として統合する等。
(ご近所PG)

考慮する点忘れていました。すみません。重複の可能性はありません。
しかし、念のためですが、シート名がかぶった場合にはシート名重複エラーとして扱っいただきたいのですが・・。 お願いいたします。

  (香織)


 この手の質問が最近やけに多い。
http://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=69743&rev=0
http://park7.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200502/05020076.txt
  (INA) 

 私の回答は
 >まとめる際のマクロは『総合.xls』に記載したいのですが可能ですか?
ここ↑に対してのみと捕らえてください。
具体的なコードはINAさん紹介の場所など参照の上、まずはコーディングにトライ。
#誰かが書いてくれるかもだけど
(ご近所PG)詰まったら質問


御教授ありがとうございます。参照見ましたが、全然わからないので、調べながら
やって見ます。 (香織)

 一応責任サンプルあげ。
追記:バックアップを取った上で実行の事
Sub 複数のブックのシートを一つブックにまとめる()
    On Error GoTo ErrorHandler
    Dim strPath As String
    Dim strBookName As String
    Dim TargetBook As Workbook
    Dim OriginalSheet As Worksheet
    '指定した場所にあるxlsファイルについて処理
    strPath = ThisWorkbook.Path '自分自身と同じ場所とする
    strBookName = Dir(strPath & "\*.xls") 'ファイル名取得
    '対象ファイルが存在する限り処理
    Do While strBookName <> ""
        If ThisWorkbook.Name <> strBookName Then '自分自身じゃないなら
            'そのブックを開く
            Set TargetBook = Workbooks.Open(strPath & "\" & strBookName)
            '開いたブックの全てのシートを処理
            For Each OriginalSheet In TargetBook.Worksheets
                '開いたブックのシートを自身の最後にコピー
                OriginalSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
                'コピーしたシートの名前をコピー元ブック名&シート名に変更
                'ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = TargetBook.Name & OriginalSheet.Name
                'コピーしたシートの名前をコピー元シート名に変更
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = OriginalSheet.Name
            Next
            '開いたブックを閉じる
            TargetBook.Close
            Set TargetBook = Nothing
        End If
        strBookName = Dir '次のファイル
    Loop
    Exit Sub
ErrorHandler:
    'エラーが起きたら
    If Not (TargetBook Is Nothing) Then
        TargetBook.Close
    End If
    If Err Then
        MsgBox Err.Number & ":" & Err.Description, vbExclamation
        Err.Clear
    End If
End Sub
総合に該当するブックの標準モジュールに記載。
対象は自分自身と同じフォルダ内の全てのxlsファイル。
シート名に関する判定及びエラー処理なし。
(ご近所PG)外出予定…

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.