Excel VBAでフォルダとファイルを自動で作成する

Excel VBA すべて

2024.10.312024.07.18

以前の投稿で「複数のフォルダーの中にあるエクセルのファイルを検索する」という内容の投稿があったと思いますが、事前にフォルダの中にファイルが入ったテストデータを作成するのは案外時間がかかってしまうのでそれを全部自動で行ってしまおうという記事を書きたいと思います。

今回はExcel VBAでファイルが3つずつ入ったフォルダを12個作成する方法を紹介します。

先ずエクセルシートのSheet1の1行目にフォルダの名前を横一列に12個入力します、そして2行目から13行目にはファイルの名前を三つずつ入力します、マクロを実行したときに結果が分かりやすいようフォルダ名とファイル名には連続の番号を振ってあります。

VBEの画面を表示して標準モジュールを作成し下のコードをコピーして貼り付けます

Sub フォルダを12個作りその中にファイルを自動で作成する()

Dim i As Long
Dim j As Long
Dim K As Long

K = 2                                                                                   '行番号の初期値を2にします。

For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column            '1行目の1列から最終列のまで繰り返し処理します。

   Dim folder_name As String
   folder_name = Cells(1, i).Value                                         '1行目のCells(行, 列)の値を変数に入れる。
   
   MkDir ThisWorkbook.Path & "\" & folder_name                               'セルの値で12個のフォルダを作成します。
   
   For j = 1 To Cells(K, Columns.Count).End(xlToLeft).Column '2行目から13行目の1列から最終列まで繰り返し処理します。
   
      Dim book_name As String
      book_name = Cells(K, j).Value                              '2行目から13行目のCells(行, 列)の値を変数に入れる。
      
      Workbooks.Add             'ワークブックを作成します。(作成したワークブックはアクティブワークブックになります)
   
      ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & folder_name & "\" & book_name & ".xlsx"  'ブックを保存します。
   
      ActiveWorkbook.Close savechanges:=False              '作成したワークブックをメッセージを表示しないで閉じます。
     
   Next j
   
   K = K + 1                                                                                   '行番号を一つ増やす。
   
Next i

End Sub