PDA

View Full Version : [SOLVED] Create multiple workbooks from a filtered list



Beatrix
09-21-2015, 11:35 AM
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
09-21-2015, 05:18 PM
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
09-22-2015, 11:21 AM
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)