経理部員のプログラミング勉強日記

経理、プログラミング、データ分析などを生業にする30代男性会社員の行動記録です。

ExcelVBA 仕訳帳から特定の勘定科目をフィルタ抽出して別のファイルに切り出すマクロ

一番左のシートに仕訳帳などを貼る(8列目が勘定科目名であることを想定)。
2番目のシートには抽出対象の勘定科目をマスタにしておく。
出力するファイルは重複を避けるためファイル名に現在日時をつける。

Sub 複数のブックに分割()

    Dim フォルダ, セル, ブック,As String= Format(Now, "yyyymmddhhmmss")
    
    Application.ScreenUpdating = False

    With ThisWorkbook
        フォルダ = .Path
        For Each セル In .Worksheets(2).Range("A2:A18")
            'ブランクが出てきたらfor文を抜けて終了
            If セル = "" Then Exit For
    
            .Worksheets(1).Range("A1").AutoFilter 8, セル.Value
            Set ブック = Workbooks.Add
            .Worksheets(1).Range("A1").CurrentRegion.Copy
            ブック.Worksheets(1).Range("A1").PasteSpecial
            Application.CutCopyMode = False
            ブック.SaveAs フォルダ & "\" && セル.Value & ".xlsx"
            ブック.Close
        Next
    End With

    Application.DisplayAlerts = False
    ThisWorkbook.Close
    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

End Sub