【ExcelVBA入門】指定の項目を読み取って大量のブックを作る方法!

名前だけ変えたブック作りたい時ないですか?
私はたまにあります。

スポンサーリンク

意外と簡単で応用も聞く

Sub test1()

Dim Path As String
Dim a, Bname
Dim n As Long

Application.DisplayAlerts = False


    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
        
            Path = .SelectedItems(1) & "\"

        Else: Exit Sub
        
        End If
    End With
    
a = Range("A1").CurrentRegion 'とりあえずA1から項目が下に並んでるイメージで

For n = 1 To UBound(a)

    If a(n, 1) = "" Then  '項目名が空白だったら止める
    
        Exit For
    
    Else
        Bname = Path & a(n, 1)
        Workbooks.Add.SaveAs Filename:=Bname & ".xlsx"
        ActiveWorkbook.Close
    
    End If

Next n

Application.DisplayAlerts = True

End Sub

これで大量のからファイルが作れます笑

ちょっとした解説

Application.DisplayAlerts = False

ある意味最大のポイントです。

保存するときにいちいち確認されるとVBAは止まってしまいます。
なのでアラートをきります。

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
Path = .SelectedItems(1) & “\”
Else: Exit Sub
End If
End With

ファイルダイアログを開いて場所を確認します。
選べた方がいいでしょ。

キャンセル押したら即終了にするため、IFで分岐させます。

a = Range(“A1”).CurrentRegion ‘とりあえずA1から項目が下に並んでるイメージで

ここは何でもいいです。
とにかくaという配列に書きだしたい項目列を入れ込んでください。

a = Range(“A1:A20”)とかでもいいです。

Bname = Path & a(n, 1)
Workbooks.Add.SaveAs Filename:=Bname & “.xlsx”
ActiveWorkbook.Close

保存先とファイル名を直で指定しています。
この方がシンプルで見やすいでしょ。
それで即閉じです。

各ブックに何か入れたいなら

空ファイルではなく、中に何か入れたいのなら

Bname = Path & a(n, 1)
Workbooks.Add.SaveAs Filename:=Bname & “.xlsx”
↑この間で処理するのがおすすめです。

ActiveWorkbook.Close

なんでもOKです。

スポンサーリンク

おわり

使い道を見つけるのが大事です。

自由コメント 登録不要です!

タイトルとURLをコピーしました