Create multiple workbooks from a filtered list

[Beatrix]

Hi Everyone ,

I am trying to create multiple workbooks from a list based on filtered data in column B. There are 56 unique items listed on the filter so I need 56 separate workbooks. I am using below macro which does the job but I need to make it dynamic to apply for all filtered items in one go. Can anyone help on how to do this ?

Cheers
B.


Criteria1:= "X"
ActiveCell.FormulaR1C1 = "X"
"C:\Users\vbax\X.xlsx"

Range("B3:B4").Select
    Selection.AutoFilter
    Range("B4").Select
    ActiveSheet.Range("$B$3:$B$1045").AutoFilter Field:=1, Criteria1:= _
        "X"
    Cells.Select
    Selection.Copy
    Workbooks.Add
    Cells.Select
    ActiveSheet.Paste
    Columns("A:Z").Select
    Columns("A:Z").EntireColumn.AutoFit
    Range("B4").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "X"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\vbax\X.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Range("A4").Select
    ActiveWindow.Close
End Sub

[SamT]

I took your Macro code, removed all the Macro Recorder added redundancy and made it a Procedure (Subroutine or Function.) Then I Gave it an Input Parameter so you can use another Subroutine to gather the 56 values and feed them to this Sub one at a time in a loop.

Sub SamT(FName As String)

With ThisWorkBook.Sheets("X") 'Edit as needed
.Range("B3:B4").AutoFilter 'Note dot before Range. Means Range is on (With) Sheets("X")
.Range("$B$3:$B$1045").AutoFilter Field:=1, Criteria1:=FName
.Cells.Copy
End With

Workbooks.Add
ActiveSheet.Range("A1").Paste
Application.CutCopyMode = False
Range("B4").Value = FName
Columns("A:Z").AutoFit

ActiveWorkbook.SaveAs Filename:= _
"C:\Users\vbax\" & FName & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
End Sub

[Beatrix]

Thanks very much for your reply SamT however it gave an error regarding the SaveAs Method and I couldn't use it. I spent time on it to work it out but did end up creating 56 workbook manually :o)