Datum kleines als als Bedingung zum Kopieren

[sandormiles]

Mit dem nachfolgenden Makro kopiere ich Zeilen von einem in ein anderes Tabellenblatt. Nun möchte ich noch eine weitere zu erfüllende Bedingung einfügen. Es sollen nur Datensätze kopiert werden, die auch älter als (Bspr.) 6 Monate sind. Spalte K (i, 11) ist mit Datumsangaben gefüllt.

Code:

Sub R1_älter_6()
Dim i As Long, tLR As Long
Dim tarWks As Worksheet, srcWks As Worksheet
Set srcWks = Worksheets("WS_Wohn A")
Set tarWks = Worksheets("Listen")
With srcWks
   For i = 1 To .Cells(.Rows.Count, 10).End(xlUp).Row
       If .Cells(i, 7).Value = "R1" And .Cells(i, 13).Value = "" And ... Then
       
       
           tLR = tarWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
           Debug.Print tLR
           With tarWks
               .Range(.Cells(tLR, 1), .Cells(tLR, 6)).Value = srcWks.Range(srcWks.Cells(i, 1), _
srcWks.Cells(i, 7)).Value
           End With
       End If
   Next i
End With
End Sub

Grüße und Danke

[Steffl]

Hallo,

teste mal

Code:

Sub R1_älter_6()
Dim i As Long, tLR As Long
Dim tarWks As Worksheet, srcWks As Worksheet
Set srcWks = Worksheets("WS_Wohn A")
Set tarWks = Worksheets("Listen")
With srcWks
   For i = 1 To .Cells(.Rows.Count, 10).End(xlUp).Row
       If .Cells(i, 7).Value = "R1" And .Cells(i, 13).Value = "" And .Cells(i, 11) < DateSerial(Year(Date), Month(Date) - 6, Day(Date)) Then
      
      
           tLR = tarWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
           Debug.Print tLR
           With tarWks
               .Range(.Cells(tLR, 1), .Cells(tLR, 6)).Value = srcWks.Range(srcWks.Cells(i, 1), _
srcWks.Cells(i, 7)).Value
           End With
       End If
   Next i
End With
End Sub

[sandormiles]

Auch das Funktioniert! Danke Stefan!