Kopieren bestimmter Zelle aus ListObject

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

Hi Dietmar
Vielleicht hast du vergessen die Links zu deinen erwähnten Anhängen in den Beitrag zu kopieren.
Als "Trockenübung" funktioniert folgender Schnipsel ohne Probleme:

Sub t()
Dim strZwB As String
With ActiveSheet.ListObjects.Item(1)
If .ListColumns("Nachweis/Bericht vom").DataBodyRange(2) = DateValue("11.11.1911") Then
strZwB = .ListColumns("Beginn des Berichtszeitraumes").DataBodyRange(2)
.ListColumns("Beginn des Berichtszeitraumes").DataBodyRange(3) = strZwB
End If
End With
End Sub

Dass bei dir die If-Bedingung gar nicht erst erfüllt wird, könnte daran liegen, dass in Zeile 3 (Titel wird nicht mitgezählt) kein echtes Datum/Zahl sondern Text steht. Lässt sich einfach prüfen:
=ISTZAHL(B3)
Da du von einer Datenbankabfrage sprichst, könnte dir Power-Query (PQ) als Alternative zu VBA helfen. PQ ist für Abfragen (=Query) bestens geeignet und die Typenkonvertierung (Text in Datum) lässt sich leicht realisieren.
https://excelhero.de/power-query/power-query-ganz-einfach-erklaert/
Bei Bedarf kannst du mal ein vereinfachtes, anonymisiertes Beispiel deiner Rohdaten (gerne als XLSX, da ich keine Makrodateien downloaden kann) ins Forum stellen und dein Ziel erläutern (nach welchem Kriterium soll konkret gefiltert werden und wie soll das Ergebnis aussehen).
cu
Chris

Kopieren bestimmter Zelle aus ListObject

Forumthread: Kopieren bestimmter Zelle aus ListObject

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial