Saving sheets within excel as seperate csv files

[jeremypyle]

Hi

I have a macro that is saving sheets within my excel document as seperate csv files. However if the sheets have the filter command then this doesn't work. Is there a way to make this work saving on the visible values from the filter as csv?



Sub SaveFiles1()

Dim ShtGroup() As String
Dim Lr As Long, ws As Worksheet
Dim ShtName As String, c As Range
Dim n As Long
Lr = Sheets("Person Paying").Range("B" & Rows.Count).End(xlUp).Row
For Each c In Sheets("Person Paying").Range("B1:b" & Lr)
ShtName = c.Value & " IRD"
On Error Resume Next
Set ws = Sheets(ShtName)
On Error GoTo 0
If Not ws Is Nothing Then
n = n + 1
ReDim Preserve ShtGroup(1 To n)
ShtGroup = ShtName
End If
Set ws = Nothing
Next


For Each ws In Sheets(ShtGroup)

If ws.Range("A1") <> "" Then
ws.Copy
xcsvFile = "C:\OneDrive\Houses\Business\Wages\CSV\IRD" & "\ird_" & ws.Name & ".csv"
Application.ActiveWorkbook.SaveAs Filename:=xcsvFile, _
FileFormat:=xlCSV, CreateBackup:=False
Application.ActiveWorkbook.Saved = True
Application.ActiveWorkbook.Close
End If



Next

End Sub

 

[rondeondo]

Hi jeremypyle,
I see in your code you are doing ws.copy but you don't have a paste anywhere. If you open a new file and paste into that then save the new file then you will get just the visible rows when it's filtered.
I have a macro that does something similar, in mine I have a sheet with a list of unique values that are found in one column of the main data to export. My code then cycles through the list of values and filters the data by that field and saves it out.

 

[jeremypyle]

Thanks, I'm very new to VBA as normally only use formulas. I'm not quite sure how to add the code to open a new file and paste into that. What would I need to add to the code to do this?

 

[rondeondo]

Hi Jeremy,
yeah it's hard to know what to search for some times.
I use the following to create a new sheet and then take your pick of what you want to paste, if it's for CSV export you don't need to bother with formatting and can just paste values
Slot this in after your "ws.copy" line

Set newFile = Workbooks.Add
With newFile
    Set newSheet = .Sheets(1)
               
newSheet.Range("A1").PasteSpecial xlPasteColumnWidths, xlPasteSpecialOperationNone, False, False
newSheet.Range("A1").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
newSheet.Range("A1").PasteSpecial xlPasteFormats, xlPasteSpecialOperationNone, False, False
newSheet.Range("A1", newSheet.Cells.SpecialCells(xlLastCell)).EntireColumn.AutoFit


Application.DisplayAlerts = False  'turn off error messages comment this out while your testing
'for this logic to work you'll need to set some variables. I do this for paths and filenames so I can build a filename from the data available. Your existing save will work. This is just me showing off
If outputFileType = "CSV" Then
    .SaveAs fileName:=outputFilePath & outputFileName & Replace(Replace(supplierName, "/", ""), "|", " - ") & outputFileSuffix & ".csv", FileFormat:=xlCSV, ConflictResolution:=xlLocalSessionChanges, Local:=True
Else
   .SaveAs fileName:=outputFilePath & outputFileName & Replace(Replace(supplierName, "/", ""), "|", " - ") & outputFileSuffix & ".xlsx", ConflictResolution:=xlLocalSessionChanges
End If

Application.DisplayAlerts = True   'turn annoying error messages back on, helps when you close without saving, if you leave this off excel will happily close without save and no prompt
newFile.Close False   'close your new file when you're finished with it.

 

[jeremypyle]

Hi Rondeondo very sorry I have been away. This works great thanks. I can use this in some of my other sheets now as well