Hallo!
Ich arbeite mit meinem Code in zwei Tabellenblättern. Im Blatt SAP sind verschiedene Q-Nummern (ab I5 untereinander) einem Datum (ab AH5 untereinander) zugeordnet bzw. stehen in einer Zeile jeweils. Im Blatt meiner neuen Vorlage ist ein Datumsbereich (Zelle L9 und O9) angeben und in dieses Blatt sollen die Q-Nummern (untereinander ab B111) eingetragen werden.
Das Ziel ist, dass man für den gewünschten Datumsbereich, den man in Blatt "neue Vorlage" einträgt, die ganzen Datums im Blatt SAp durchsucht werden und wenn die übereinstimmen, dann sollen die Werte (Zahl) aus Spalte ab I5 nach B111 untereinander kopiert werden.
das ist mein bisheriger Versuch, der leider nicht funktioniert:
Sub Q()

'Definieren der Variablen für zu kopierenden Bereich in SAP
Dim QuellenRange As Range

'Datumsabgleich und Kopie erstellen in neue Vorlage
Dim datumAnfang As Date
Dim datumEnde As Date
datumAnfang = Worksheets("neue VORLAGE").Range("L9").Value 'Anfang des betrachteten Zeitraums
datumEnde = Worksheets("neue VORLAGE").Range("O9").Value 'Ende des betrachteten Zeitraums

Dim anfangSuchen As Date
Dim endeSuchen As Date
anfangSuchen = Worksheets("SAP").Range("AH5").Value 'durchsucht Datumsbereich in SAP nach Anfang
endeSuchen = Worksheets("SAP").Range("AH5").Value 'durchsucht Datumsbereich in SAP nach Ende

Dim i As Integer
i = 5 'Zählen der Zeilen in "SAP"

'Dim ZielZelle As Range
'Set ZielZelle = Worksheets("neue VORLAGE").Range("B110") 'hier soll Q-Meldung hin kopiert werden

Dim sicherheit As Long
sicherheit = 0 'damit keine Endlosschleife entsteht(unten Code dazu)

Application.Goto ActiveWorkbook.Sheets("SAP").Range("AH5")

Do Until IsEmpty(ActiveCell) 'durchsuchen der Spalte AH bis kein Eintrag mehr darinsteht

i = i + 1 'nach jedem Durchlauf i erhöhen, um zu neuer Q-Meldung zu springen

anfangSuchen = Worksheets("SAP").Range("AH" & i).Value


If datumAnfang = anfangSuchen Then
Set QuellenRange = Worksheets("SAP").Cells(i, 9)
'QuellenRange.Copy (Worksheets("neue VORLAGE").Range("B110"))

QuellenRange.Copy _
Destination:=Worksheets("neue VORLAGE").Range("B110")
End If

'If datumAnfang = anfangSuchen And datumEnde >= endeSuchen Then
'Set QuellenRange = Worksheets("SAP").Cells(i, 9)

'QuellenRange.Copy Destination:=ZielZelle + 1 'Zielort der Q-Meldungsnummer in Vorlage

'End If

sicherheit = sicherheit + 1 'Abbruchkriterium falls Endlosschleife
If sicherheit > 20000 Then
MsgBox "Vermutlich Endlosschleife"
Exit Do
End If
Loop

End Sub