+- Office-Fragen.de (https://office-fragen.de)
+-- Forum: Microsoft Office (https://office-fragen.de/forum-1.html)
+--- Forum: Excel (https://office-fragen.de/forum-2.html)
+--- Thema: Filterung von ListObject in mehreren Schleifen (/thread-18362.html)
Filterung von ListObject in mehreren Schleifen - Caligula - 03.03.2021
Liebe Profis,
ich habe folgendes Problem:
Eine Arbeitsmappe, mit 3 Blättern
das Modul erstellt auf den Blättern "Grunddaten" und "Termindaten" je ein ListObject.
Danach werden die Zeilen der Grunddaten in Schleifen abgearbeitet und bestimmte Daten für die Filterung des Blattes Termindaten verwendet.
Diese , auf dem Blatt Termindaten gefilterten Daten werden nach Terminübersicht copiert.
Zu beachten ist, dass bei der Filterung die Rang LEER sein kann.
Das habe ich in einer Fehlerroutine abgefangen.
Soweit, so gut, in der ersten Schleife funktioniert das auch, aber in der 2. Schleifen ignoriert er den Fehler, dass keine Daten in der Filterung sind.
Welchen Fehler mache ich?
Kann mir jemand helfen?
Ich habe den Code als Attechment angefügt.
Hier noch mal die Stelle an der es hakt:
If wrkShtTerm.FilterMode Then wrkShtTerm.ShowAllData
With LOTerm
.Range.AutoFilter Field:=1, Criteria1:=strFKZ
.Range.AutoFilter Field:=5, Criteria1:="Zwischenbericht"
.Range.AutoFilter Field:=11, Criteria1:=""
On Error Resume Next
Set rngLOTerm = .DataBodyRange.SpecialCells(xlVisible)
On Error GoTo 0
If Not rngLOTerm Is Nothing Then
wrkShtTerm.Range("E2:E" & wrkShtTerm.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible).Copy Destination:=wrkShtUeber.Range("A15")
wrkShtTerm.Range("H2:J" & wrkShtTerm.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible).Copy Destination:=wrkShtUeber.Range("B15")
End If
End With
Vielen Dank im Voraus
Dietmar
RE: Filterung von ListObject in mehreren Schleifen - Caligula - 04.03.2021
So, habe das Problem selbst gelöst
für Alle, die es interessiert:
With LOTerm
.Range.AutoFilter Field:=1, Criteria1:=strFKZ
.Range.AutoFilter Field:=5, Criteria1:="Zwischenbericht"
.Range.AutoFilter Field:=12, Criteria1:=""
On Error Resume Next
Set rngLOTerm = .DataBodyRange.Columns(1).SpecialCells(xlVisible)
' On Error GoTo 0
If Not rngLOTerm Is Nothing Then
wrkShtTerm.Range("E2:E" & wrkShtTerm.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible).Copy Destination:=wrkShtUeber.Range("A15")
wrkShtTerm.Range("H2:J" & wrkShtTerm.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible).Copy Destination:=wrkShtUeber.Range("B15")
End If
On Error GoTo 0
End With