Hallo liebe Experten,
zuerst stelle ich mich vor. Mein Name ist Dietmar.
Ich habe ein Problem mit den Listen Objekten an einer Stelle.
Vorab, die Module laufen wunderbar bis auf eine Stelle, an der ich immer wieder scheitere.
Es geht hierbei um eine If-Abfrage, die nachträglich einfügen musste, um einen bestimmten Fall abzudecken.
Im Anhang senden ich den gesamten Code. Ja, ich weiß, etliche Zeilen kann man in Sub-Routinen zusammenfassen, aber ich bin erst einmal froh, dass es soweit läuft. Die Feinarbeit kommt noch. Ich bitte auch um Veständnis, dass ich nicht das original Worksheet senden kann, da hier sehr viele personebezogene Daten (Datenschutz) vorhanden sind. Ich lege aber ein Bild bei, dass das Problem verdeutlichen sollte.
Hier da Problem:
Ich habe eine intelligente, gefilterte Tabelle. jetzt brauch ich eine IF-Abfrage in dieser Tabelle. Wenn die Bedingung in Feld "K13" erfüllt ist, also "11.11.1911" (Dummydatum), dann soll das Datum aus Zelle Zelle "H13" nach "H14" kopiert werden. Anschließend wir die Zeile "13" herausgefiltert.
Soweit die Erklärung, nur passiert nichts. Schon bei der IF-Abfrage überspringt er den folgenden Code. Die Adressierung der Spalten mit den Header-Überschriften brauche ich, da es immer wieder mal passieren kann, dass sich die Sortierreihenfolge der Datenbankabfrage ändert, die Namen der Spalten aber bleiben.
Hier die Stelle, an der es klemmt:
With LOTerm
.Range.AutoFilter Field:=1, Criteria1:=strFKZ
.Range.AutoFilter Field:=5, Criteria1:="Zwischenbericht"
'MsgBox LOTerm.ListColumns("Nachweis/Bericht vom").DataBodyRange(3)
If LOTerm.ListColumns("Nachweis/Bericht vom").DataBodyRange(2) = DateValue("11.11.1911") Then
strZwB = LOTerm.ListColumns("Beginn des Berichtszeitraumes").DataBodyRange(2)
LOTerm.ListColumns("Beginn des Berichtszeitraumes").DataBodyRange(3) = strZwB
End If
.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
Im Vorraus vielen Dank
Dietmar