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