VBA code modification assistance

[allanjones863]

I need the code below to save as an xlsb file in the current directory (same as original file), also need to be able to select the column to create workbooks (set as column 4 below), need input dialog to select which column to use. Further would like the new file set to filtered.

Thank You


Sub PrepareFiles()
Dim DistDic As Object
Set DistDic = CreateObject("Scripting.Dictionary")
Dim WkRg As Range, Rg As Range
Dim K
Dim WkP As String
Application.ScreenUpdating = False
WkP = ActiveWorkbook.Path
Set WkRg = ActiveSheet.UsedRange
ActiveSheet.AutoFilterMode = False
For Each Rg In WkRg.Columns(4).Cells.Offset(1)
If (Rg <> "") Then DistDic.Item(Rg.Value) = Empty
Next Rg
For Each K In DistDic.keys
With WkRg
.AutoFilter Field:=4, Criteria1:=K
End With
Workbooks.Add
WkRg.SpecialCells(xlCellTypeVisible).Copy Destination:=Cells(1, 1)
Cells.EntireColumn.AutoFit
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Fpath & "\" & FName & ".xlsb", FileFormat:=50
Application.DisplayAlerts = True
ActiveWorkbook.Close
Next K
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
MsgBox ("Job Done")
End Sub

 

[Joe4]

Duplicate to: Save extracted files in current directory and more.

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread. If you do not receive a response, you can "bump" it by replying to it yourself, though we advise you to wait 24 hours before doing so, and not to bump a thread more than once a day.