Hallo,

in dieser Muster-Arbeitsmappe wurde der angepasste Code abgespeichert:

Sub FiterData()
    Dim wsh As Worksheet
    Dim iNum As Integer
    Dim iMxNum As Integer
    Dim strFilename As String
    Dim wbkIns As Workbook
    Dim rngFlt As Range
    Set wsh = ThisWorkbook.Worksheets(1)
    Application.ScreenUpdating = False
    With wsh
        iMxNum = WorksheetFunction.Max(wsh.Range("B:B"))
        For iNum = 0 To iMxNum
            If .AutoFilterMode Then
                .UsedRange.AutoFilter
            End If
            .UsedRange.AutoFilter Field:=2, Criteria1:=iNum
            If CountVisibledRows(.UsedRange.SpecialCells(xlCellTypeVisible)) > 1 Then
                Debug.Print iNum
                Set wbkIns = Nothing
                .UsedRange.SpecialCells(xlCellTypeVisible).Copy
                Set wbkIns = Application.Workbooks.Add
                wbkIns.Worksheets(1).Paste
                VBA.DoEvents
                If Not wbkIns Is Nothing Then
                    strFilename = ThisWorkbook.FullName & " - " & CStr(iNum) & ".xlsx"
                    If Not Dir(strFilename) = "" Then
                        Kill strFilename
                    End If
                    wbkIns.SaveAs strFilename
                    wbkIns.Close True
                End If
            End If
            .UsedRange.AutoFilter
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Function CountVisibledRows(rng As Range) As Integer
    Dim iCnt As Integer
    Dim rngChk As Range
    Dim iArea As Integer
    For iArea = 1 To rng.Areas.Count
        For Each rngChk In rng.Areas(iArea).Rows
            iCnt = iCnt + IIf(rngChk.RowHeight = 0, 0, 1) ' Nur die Zeilen mit einer Zeilenhöhe von mehr als 0 px. zählen
        Next
    Next
    CountVisibledRows = iCnt
End Function

Das Problem bestand darin, dass die Funktion SpecialCells(xlCellTypeVisible).Count nur dann korrekt ausgeführt wird, solange mindestens eine sichbare Zelle in Bereich existiert.

Zusätzlich berücksichtigt von der SpecialCells die Count Methode nur den ersten Bereich. Alle weiteren Bereiche bleiben unberücksichtigt. Das würde ich als einen schweren Bug ansehen.

Deswegen musste eine eigene Count-Funktion erstellt werden, die immer die korrekt Anzahl von sichtbaren Zeilen zurückliefert.

Mit dieser Version sollten keine Laufzeitfehler mehr auftreten.

Falls dennoch weiterhin Laufzeitfehler auftreten sollten, brauche ich den Befehl, der den Laufzeitfehler verursacht sowie die Tabellen-Daten. Mit den Informationen kann versucht werden, die Fehlersituation nachzustellen.

Das Makro wurde getestet auf Excel 2013.

LG, Ben