Sub Split()
Dim wb As String
Dim ws As String
wb = ActiveWorkbook.Name
ws = ActiveSheet.Name
Vcolumn = InputBox("Please indicate which column (i.e. A,B,C,...), you would like to split by", "Column selection")
Columns(Vcolumn).Copy
Sheets.Add
ActiveSheet.Name = "_Summary"
Range("A1").PasteSpecial
Columns("A").RemoveDuplicates Columns:=1, Header:=x1Yes
vCounter = Range("B" & Row.Count).End(xlUp).Row
For i = 2 To vCounter
vfilter = Sheets("_Summary").Cells(i, 1)
Sheets(ws).Activate
ActiveSheet.Columns.AutoFilter field:=Columns(Vcolumn).Column, Criteria1:=vfilter
Cells.Copy
Workbooks.Add
Range("A1").PasteSpecial
If vfilter <> "" Then
ActiveWorkbook.SaveAs ThiWorkbook.Path & "\Split Result" & vfilter
Else
ActiveWorkbook.SaveAs ThisWorkbook.Path & "Split Result\_Empty"
End If
ActiveWorkbook.Close
Workbooks(wb).Activate
Next i
Sheets("_Summary").Delete
End Sub
Dim wb As String
Dim ws As String
wb = ActiveWorkbook.Name
ws = ActiveSheet.Name
Vcolumn = InputBox("Please indicate which column (i.e. A,B,C,...), you would like to split by", "Column selection")
Columns(Vcolumn).Copy
Sheets.Add
ActiveSheet.Name = "_Summary"
Range("A1").PasteSpecial
Columns("A").RemoveDuplicates Columns:=1, Header:=x1Yes
vCounter = Range("B" & Row.Count).End(xlUp).Row
For i = 2 To vCounter
vfilter = Sheets("_Summary").Cells(i, 1)
Sheets(ws).Activate
ActiveSheet.Columns.AutoFilter field:=Columns(Vcolumn).Column, Criteria1:=vfilter
Cells.Copy
Workbooks.Add
Range("A1").PasteSpecial
If vfilter <> "" Then
ActiveWorkbook.SaveAs ThiWorkbook.Path & "\Split Result" & vfilter
Else
ActiveWorkbook.SaveAs ThisWorkbook.Path & "Split Result\_Empty"
End If
ActiveWorkbook.Close
Workbooks(wb).Activate
Next i
Sheets("_Summary").Delete
End Sub