bij datum overschrijding cel dan regel kopieren

[DBOD]

Hallo,

Graag wil ik een code die doet wat ik wil.
Ik heb een excel bestand met diverse tabbladen. In de tabbladen staan gegevens met in kolom D de datum tot wanneer het geldig is. Nu wil ik zodra deze datum verstreken is, de Hele rij naar het eerste tabblad kopieert. Ik ben al een eindje op weg maar loop nu vast.

Sub Macro1()
'
For Each Cel In Range("D4100")
If Cel.Value >= (Range("C2")-60) Then
EntireRow.Copy (Dit klopt niet)
Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
End If
Next

End Sub

Wat moet er staan bij (dit klopt niet)???

 

[edmoor]

Ik denk dat die smiley je zit te pesten.
Zet je sub eens in een code tag.

 

[ExcelAmateur]

DBOD,

Kijk eens of hij zo wel werkt.

Sub Macro1()
  For Each Cel In Range("D4:D100")
    If Cel.Value >= (Range("C2") - 60) Then
      EntireRow.Cel.Copy
      Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    End If
  Next
End Sub

 

[DBOD]

Bedankt voor je snelle reactie

Heaas werkt het niet.
hij zegt object required.
Ik werk met office 2003

 

[zapatr]

hij zegt object required.

DBOD,
Is de naam van het blad waarin de macro zijn werk moet doen, bij jou ook Sheet1 zoals in de code hierboven?

 

[DBOD]

Goedemorgen iedereen,

De macro heb ik achter het blad sheet 2 staan en het moet gekopieerd worden naar de eerst volgende lege regel in blad 1

 

[zapatr]

Plaats je bestand of een voorbeeld daarvan hier op het forum,
dan is er misschien wat meer van te zeggen.

 

[Warme bakkertje]

Cel.EntireRow.Copy

 

[DBOD]

Hierbij het bestandje,

Ik wil graag dat er zodra er een regel in sheet 2 verlopen is (dat wordt dus een vergelijking met de cel uit D met cel C2. Iets van If C2>D nogwat) dan moet die regel gekopieerd worden naar sheet 1 vanaf regel 10.Bekijk bijlage test1.xls

 

[Warme bakkertje]

Sub Macro1()
  Application.ScreenUpdating = False
  With Sheets("Sheet 2")
  For Each Cel In .Range("D6:D100")
    If Cel <> "" Then
        If DateValue(Cel) >= DateValue((Range("C2") - 60)) Then
            Cel.EntireRow.Copy
            With Sheets("Sheet 1")
                .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row) _
                        .Offset(1).PasteSpecial xlValues
            End With
        End If
    End If
  Next
  End With
  With Application
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
End Sub

 

[DBOD]

Bedankt Rudi voor de snelle reactie,

Nog 1 klein probleempje kom ik tegen, Zodra ik de macro laat lopen kopieert ie alles zonder de formule uit te voeren. Stel dat ik 20 dagen voor de geldigheidsdatum hem naar het eerste sheet wil laten kopieren pakt ie alles ipv die ene rij.

gr DBOD

 

[Warme bakkertje]

If DateValue(Cel) <= Date + 20 Then

 

[DBOD]

Deze klopt ook niet,

Lastige opgave vind ik

 

[Warme bakkertje]

Ik wil graag dat er zodra er een regel in sheet 2 verlopen is

Stel dat ik 20 dagen voor de geldigheidsdatum hem naar het eerste sheet wil laten kopieren

Welke van de twee wil je nu eigenlijk ?

 

[DBOD]

ik wil dat hij 20 dagen voor tijd naar sheet 1 gaat.
Volgens mij moet er dan iets komen van
If cel.value -20 > datum van vandaag then

Meer weet ik er niet van

 

[Warme bakkertje]

If DateValue(Cel) - 20 = Date Then

Met deze gaat hij enkel de regels kopieëren waarvan de vervaldatum -20 dagen gelijk is aan de huidige datum.

 

[DBOD]

Goedemorgen Rudi,

Het werkt uitstekend. Bedankt voor de hulp