Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(指定なし : 指定なし)
複数サブフォルダの中の複数ブックのシートを1つのブックにコピーする
投稿日時: 20/06/15 17:55:39
投稿者: としぴ

「複数ブックのシートを1つのブックにコピーする」を参照させていただきました。これはメインフォルダの中に複数ブックがある想定だと思います。メインフォルダの中の複数サブフォルダの中に複数ブックがある場合には、何を書き加えればよいでしょうか?よろしくお願いします。

回答
投稿日時: 20/06/15 18:26:10
投稿者: simple

こちらの即効テクニック
「複数ブックのシートを1つのブックにコピーする」
https://www.moug.net/tech/exvba/0060003.html
のことですね。
 
サブフォルダも対象にする場合は、
「サブフォルダを含めてファイル一覧を取得する(Dir関数の再帰呼び出し)」
https://www.moug.net/tech/exvba/0060088.html
こちらの、後半にあるFileSystemObjectを使ったものが参考になると思います。
 
トライしてみて、不明点があれば継続してどうぞ。

投稿日時: 20/06/15 23:01:40
投稿者: としぴ

ありがとうございます。トライしてみます。

回答
投稿日時: 20/06/18 10:07:20
投稿者: simple

即効テクニック「サブフォルダを含めてファイル一覧を取得する(Dir関数の再帰呼び出し)」
の該当コードは以下です。
 
このコードのポイントは、※2の所で、Sample3という自分自身を呼び出しているところです。
こうしたものを「再帰」処理と言います。
まずは、簡単なフォルダ構造の例で、これをステップ実行して動作を確認するとよいと
思います。
 

Option Explicit
Dim cnt As Long

Sub Sample3(Path As String)
    Dim buf As String, f As Object
    buf = Dir(Path & "\*.*")
    Do While buf <> ""
        cnt = cnt + 1
        Cells(cnt, 1) = buf    '※1
        buf = Dir()
    Loop
    With CreateObject("Scripting.FileSystemObject")
        For Each f In .GetFolder(Path).SubFolders
            Call Sample3(f.Path)    '※2
        Next f
    End With
End Sub

Sub Test()
    cnt = 0
    Call Sample3("C:\Work")
End Sub

上記は、※1で、ワークシートにファイル名を書き出していますが、
今、やろうとしているのは、ファイルのシートを一つのブックに集約することです。
(1)
その処理部分を別途、以下のようなプロシージャに纏めておき、
Function sheetCopy(s As String)
   'フルパスsのブックを開いて、各シート(または特定のシートだけ?)を
   'ThisWorkbookの最終シートの右にコピーする
   'そのブックを閉じる
End Function
(2)
※1 の部分を
    Call sheetCopy(Path & "\" & buf)  '※1
で置き換えればよいことになります。
(3)
あとは、、Function sheetCopy(s As String)を、
https://www.moug.net/tech/exvba/0060003.html
を参考に作成すればよいと思います。
 
こんな方針でいかがでしょうか。

トピックに返信