[VBA]Autofilter - sichtbare Zellen in neue Datei speichern

[MiBi]

Hallo Community,

ich hab ein kleines VBA Problem, woraus ich nicht schlau werde. Versuche es schon lange, leider ohne Erfolg.
Ich möchte eine Datei filtern und anschließend NUR die gefilterten Daten in eine neue Excel Datei speichern. Er zeigt mir hier immer einen Fehler bei "ActiveWorkbook.SaveAs varSaveAsName" an.
Ich denke es liegt am Dateinamen. Wenn ich es auf xls ändere dann speichert er eine Datei ab, aber 1:1 die selbe. Ich brauch in der  anderen Datei jedoch nur das Tabellenblatt und die gefilterten Daten.

Würde mich sehr über eure Hilfe freuen.

Vielen Dank !


Private Sub CommandButton1_Click()
Dim varSaveAsName As Variant
varSaveAsName = Application.GetSaveAsFilename(, "EXCEL Files (*.xlsx), *.xlsx", , " ")
If VarType(varSaveAsName) <> vbBoolean Then

    Sheets("vorlage").Activate
    Sheets("vorlage").Range("A2").AutoFilter Field:=1, Criteria1:=Cells(1, 10)
    ActiveWorkbook.Worksheets("vorlage").Range("A2").SpecialCells(xlCellTypeVisible).Copy
    ActiveWorkbook.SaveAs varSaveAsName
    ActiveWorkbook.Close
End If
End Sub

[ralf_b]

Code:

Sub los()
Dim varSaveAsName As Variant
Dim wb As Workbook
Dim actwb As Workbook

Application.ScreenUpdating = False


varSaveAsName = Application.GetSaveAsFilename(, "EXCEL Files (*.xlsx), *.xlsx", , " ")
If VarType(varSaveAsName) <> vbBoolean Then

Set actwb = ActiveWorkbook
    With actwb.Sheets("Helper")
       .Activate
       .Range("A2").AutoFilter Field:=1, Criteria1:=Cells(1, 10)
       .Range("A2").SpecialCells(xlCellTypeVisible).Copy
        Set wb = Workbooks.Add
        wb.Sheets(1).Cells(1, 1).PasteSpecial
        wb.SaveAs varSaveAsName
        wb.Close
       
    End With
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True

set actwb = nothing : set wb = nothing

End Sub

versuchs mal damit.

[MiBi]

Code:

Sub los()
Dim varSaveAsName As Variant
Dim wb As Workbook
Dim actwb As Workbook

Application.ScreenUpdating = False


varSaveAsName = Application.GetSaveAsFilename(, "EXCEL Files (*.xlsx), *.xlsx", , " ")
If VarType(varSaveAsName) <> vbBoolean Then

Set actwb = ActiveWorkbook
    With actwb.Sheets("Helper")
       .Activate
       .Range("A2").AutoFilter Field:=1, Criteria1:=Cells(1, 10)
       .Range("A2").SpecialCells(xlCellTypeVisible).Copy
        Set wb = Workbooks.Add
        wb.Sheets(1).Cells(1, 1).PasteSpecial
        wb.SaveAs varSaveAsName
        wb.Close
       
    End With
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True

set actwb = nothing : set wb = nothing

End Sub

versuchs mal damit.

Vielen Dank, klappt wunderbar !
Noch ne kurze Frage: Wie kann es sein, dass die neue Datei nach dem exportieren 9000 KB groß ist und die vorherige Datei mit deutlich mehr Inhalt nur 100 KB  ?

[ralf_b]

schau mal ob in den Tabellenblättern irgendwo die Zeilen bis 1 Million runter angezeigt werden.

[MiBi]

schau mal ob in den Tabellenblättern irgendwo die Zeilen bis 1 Million runter angezeigt werden.

Daran hats gelegen :) Danke dir !