Autofilter wird bei Änderung nicht aktualisiert

Question

Mein Code aktualisiert den Autofilter nicht. Für i = 8 funktioniert der Code, aber am nächsten i wird das Autofilter-Feld nicht aktualisiert. Die "no_filtered_rows" zeigt 0 Zeilen (während sollte es sein).

For i = 8 To ostD 
accounts() = Split(Worksheets("k").Range("B" & i).Value, ",") 

For j = 0 To UBound(accounts) 
    sAccNo = Trim(accounts(j)) 

    Set rFind = .Cells.Find(sAccNo) 

    If Not rFind Is Nothing Then 

     .ShowAllData 

     .Range("A1:G" & ostD).AutoFilter Field:=3, Criteria1:=rFind 


     no_filtered_rows = .Range("A1:G" & ostD).SpecialCells(xlCellTypeVisible).Rows.Count - 1 

Answer 1

Sub insert() 
Dim i As Long, j As Long, k As Long, no_rows_filter As Integer 

With Application 
    .DisplayAlerts = False 
    .ScreenUpdating = False 
    .EnableEvents = False 
    .Calculation = xlManual 

    LastRow_dane = Worksheets("dane").Range("A" & Rows.Count).End(xlUp).Row 

    wbk.Worksheets("dane").Activate 

    With ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.Range(Cells(1, 1), Cells(LastRow_dane, 7)), , xlYes) 
     .Name = "Tabela1" 
     .TableStyle = "TableStyleLight1" 
    End With 

    LastRow_konta = Worksheets("konta").Range("A" & Rows.Count).End(xlUp).Row 
    Sheets("konta").Range("C4:G" & LastRow_konta).Clear 


    On Error Resume Next 
    Worksheets("konta").Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

    ost = Worksheets("konta").Cells(.Rows.Count, "A").End(xlUp).Row 

    Dim accounts() As String 
    Dim sAccNo As String 
    Dim rFind As Range, rCopy As Range 

    With Worksheets("dane") 
     ostD = .Cells(.Rows.Count, "C").End(xlUp).Row 

     For i = 8 To ostD 

      accounts() = Split(Worksheets("konta").Range("B" & i).Value, ",") 

      For j = 0 To UBound(accounts) 
       sAccNo = Trim(accounts(j)) 

       Set rFind = .Cells.Find(sAccNo) 

       If Not rFind Is Nothing Then 

        .ShowAllData 

        .Range("A1:G" & ostD).AutoFilter Field:=3, Criteria1:=rFind 
        no_rows_filter = .Range("A1:G" & ostD).SpecialCells(xlCellTypeVisible).Rows.Count - 1 

        Sheets("konta").Rows(i + 1).EntireRow.Resize(no_rows_filter).Insert 

        .Range("I2").Value = rFind 

        Dim r As Range 

        Set r = Sheets("konta").Range("C" & i + 1 & ":I" & i + 1) 

        .Range("Tabela1[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ 
        .Range("I1:I2"), CopyToRange:=r, Unique:=False 
        r.Delete xlShiftUp 


       End If 

      Next j 

      i = i + no_rows_filter + 1 

     Next i 

    End With 

    .DisplayAlerts = True 
    .ScreenUpdating = True 
    .EnableEvents = True 
    .Calculation = xlAutomatic 

End With 

End Sub