Filter by column then save as CSV

[thedeadzeds]

Guys, is there a way to filter by each name in column D and then save these as a separate CSV file and name it based on the name in column D.

Something similar to the below code which works fine but this saves based on the worksheet name. Ideally i dont want to create a new worksheet for each name in column D i just want to filter by column D and save as CSV

Sub Copy()

Dim ws As Worksheet, newWb As Workbook
Set MyRange = Sheets("Date").Range("A1") 'with the name of a cell


For Each ws In Sheets(Array("Bristol", "Bath", "Cardiff", "Newport"))
   ws.Copy
   Set newWb = ActiveWorkbook
   With newWb
      .SaveAs Filename:="C:\User\OneDrive\TEST\" & ws.Name & " " & MyRange.Value & " " _
      & " " & Range("R" & Rows.Count).End(xlUp).Row - 1 & " " & ".csv", FileFormat:=xlCSV
      .Close (False)
   End With
Next ws


      
End Sub

 

[Fluff]

What is the sheet name with the data?
And do you want to save the files in folder shown in you code?

 

[Fluff]

Try

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

Change values in red to suit

 

[thedeadzeds]

Works like a treat thanks very much. Can i just ask what the 6 does at the end just to help me understand it?

Ky & ".csv", 6

 

[Fluff]

You're welcome & thanks for the feedback.

The 6 is the FileFormat number for CSV
https://www.rondebruin.nl/win/s5/win001.htm

 

[thedeadzeds]

Try

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

Change values in red to suit

Hi Fluff,


You kindly put the above together for me in 2019. 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

 

[Fluff]

As this is a totally different, it needs a new thread. Thanks

 

[thedeadzeds]

As this is a totally different, it needs a new thread. Thanks

ok thanks

 

[Fluff]