Save autofiltered visible sheet to csv file?

[Dennis]

I have a auto filtered worksheet and I would like to save just the visible to a
csv file of the same file name. Below is my Macro that gives me an error "Run
time Error 438, Object does not support this property" when it attemps to save.
The debug highlights the ActiveWorkbook.Sheets(1)... line. Thanks in advance
for any help in making this work.

Sub AutofilterAnSave()

Dim MyFileName As String
Dim MyNewFileName As String
Dim strlen As Integer

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=">=8", Operator:=xlAnd
Selection.AutoFilter Field:=1, Criteria1:=">=6", Operator:=xlAnd
Selection.AutoFilter Field:=3, Criteria1:=">=0.8", Operator:=xlAnd
Selection.AutoFilter Field:=4, Criteria1:=">=0.8", Operator:=xlAnd
Selection.AutoFilter Field:=5, Criteria1:=">=0.5", Operator:=xlAnd


Application.DisplayAlerts = False
MyFileName = ActiveWorkbook.FullName
strlen = Len(MyFileName)
MyNewFileName = Left(MyFileName, strlen - 3) & "csv"

ActiveWorkbook.Sheets(1).AutoFilter.Visible.SaveAs filename:=MyNewFileName, _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True

End Sub

 

[Dave Peterson]

Sometimes, it's easier to copy the visible rows (plus the header???) to a
worksheet in a new workbook--then save that:

Option Explicit
Sub AutofilterAndSave()

Dim MyFileName As String
Dim MyNewFileName As String
Dim StrLen As Long
Dim ActWks As Worksheet
Dim NewWks As Worksheet
Dim RngToFilter As Range

Set ActWks = ActiveSheet
With ActWks
'remove any existing filter
.AutoFilterMode = False
Set RngToFilter = .Rows(2).CurrentRegion
With RngToFilter
Set RngToFilter = .Resize(.Rows.Count - 1).Offset(1, 0)
End With
With RngToFilter
.AutoFilter Field:=1, Criteria1:=">=6"
.AutoFilter Field:=3, Criteria1:=">=0.8"
.AutoFilter Field:=4, Criteria1:=">=0.8"
.AutoFilter Field:=5, Criteria1:=">=0.5"
End With
End With

If RngToFilter.Columns(1).Cells _
.SpecialCells(xlCellTypeVisible).Count = 1 Then
'only headers are visible
'don't do the copy
MsgBox "No detail rows visible"
Exit Sub
End If

Set NewWks = Workbooks.Add(1).Worksheets(1)

'copy the headers (row 2) and the visible details
ActWks.AutoFilter.Range.Copy _
Destination:=NewWks.Range("a1")

'Don't want the headers in that new file???
'newwks.rows(1).delete

MyFileName = ActiveWorkbook.FullName
StrLen = Len(MyFileName)
MyNewFileName = Left(MyFileName, StrLen - 3) & "csv"

With NewWks.Parent 'the new workbook
Application.DisplayAlerts = False
.SaveAs Filename:=MyNewFileName, FileFormat:=xlCSV, _
CreateBackup:=False
Application.DisplayAlerts = True
.Close savechanges:=False
End With

End Sub

 

[Bernie Deitrick]

Dennis,

You need to copy the filtered cells to a new worksheet, move that to a new
workbook, then save that as the CSV. And I think that your second
autofilter on Field:=1 should actually be Field:=2.... your call. Give this
version a try...

HTH,
Bernie
MS Excel MVP


Sub AutofilterAndSave2()

Dim MyFileName As String
Dim MyNewFileName As String
Dim strlen As Integer
Dim mySht As Worksheet

Set mySht = ActiveSheet

Rows("2:2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=">=8", Operator:=xlAnd
Selection.AutoFilter Field:=1, Criteria1:=">=6", Operator:=xlAnd
Selection.AutoFilter Field:=3, Criteria1:=">=0.8", Operator:=xlAnd
Selection.AutoFilter Field:=4, Criteria1:=">=0.8", Operator:=xlAnd
Selection.AutoFilter Field:=5, Criteria1:=">=0.5", Operator:=xlAnd


Application.DisplayAlerts = False
MyFileName = ActiveWorkbook.FullName
strlen = Len(MyFileName)
MyNewFileName = Left(MyFileName, strlen - 3) & "csv"

Worksheets.Add

mySht.UsedRange.SpecialCells(xlCellTypeVisible).Copy _
ActiveSheet.Range("A1")
ActiveSheet.Move
ActiveWorkbook.SaveAs Filename:=MyNewFileName, _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
ActiveWorkbook.Close False
Application.DisplayAlerts = True

End Sub

 

[Dennis]

Thank you Dave and Bernie !

That worked great.