thedeadzeds
Active Member
- Joined
- Aug 16, 2011
- Messages
- 442
- Office Version
- 365
- Platform
- Windows
Hi All,
I was wondering if there was a way to adapt this? At the moment it saves the individual workbooks to a single folder. Is there a way to save each one to an individual folder based on the same name as the filter. Also, is there a way to save this as an Excel workbook rather than CSV and copy the formatting, ie, font, colours etc.
Many thanks
I was wondering if there was a way to adapt this? At the moment it saves the individual workbooks to a single folder. Is there a way to save each one to an individual folder based on the same name as the filter. Also, is there a way to save this as an Excel workbook rather than CSV and copy the formatting, ie, font, colours etc.
Many thanks
VBA Code:
Sub thedeadzeds()
Dim Cl As Range
Dim Ws As Worksheet, Ws2 As Worksheet
Dim Ky As Variant
Application.ScreenUpdating = False
Set Ws = Sheets("[COLOR=#ff0000]pcode[/COLOR]")
If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
With CreateObject("scripting.dictionary")
For Each Cl In Ws.Range("D2", Ws.Range("D" & Rows.Count).End(xlUp))
.Item(Cl.Value) = Empty
Next Cl
For Each Ky In .Keys
Ws.Copy
Set Ws2 = ActiveSheet
Ws2.Range("A1").AutoFilter 4, "<>" & Ky
Ws2.AutoFilter.Range.Offset(1).EntireRow.Delete
Ws2.AutoFilterMode = False
Ws2.Parent.SaveAs "[COLOR=#ff0000]C:\Users\OneDrive\test\[/COLOR]" & Ky & ".csv", 6
Ws2.Parent.Close False
Next Ky
End With
End Sub