Datum opmaak behouden na knippen

[JeroenvanBaekel]

Goedenavond,

Ik heb een Excel sheet waarin ik de inhoud van een rij op Blad 1 naar Blad 2 wil kopiëren wanneer de datum in kolom B kleiner is dan vandaag. De datum notatie in de kolommen A en B zijn in een specifieke opmaak gemaakt. De rijen 1 en 2 zijn vaste rijen en mogen niet meegekopieerd worden.

Het lukt mij (met behulp van een stukje VBA code gevonden op een forum, ik heb maar een klein beetje verstand van VBA) om de inhoud van de rij te kopiëren naar het volgende blad, maar de opmaak van de cellen in de kolom B gaat verloren (zie rij 3, 17 en 24) en het lukt mij niet om dit vast te zetten of de opmaak mee te kopiëren. Wie kan mij helpen?

Vriendelijke groet,

Jeroen

 

[HSV]

Als ik gewoon in een willekeurige cel in kolom B een datum verander waarvan de opmaak met die specifieke opmaak is geregeld zie ik geen probleem Jeroen.

 

[JeroenvanBaekel]

Harry, Bedankt voor jouw reactie. Het probleem doet zich voor in rijen waarvan de data is geknipt en in Blad2 is geplakt. Wanneer ik die rij "hergebruik" is de opmaak weg.

Groet,

Jeroen

 

[HSV]

Ach zo,
Blad1:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 Then
    If Target.Value < Date Then
        Range(Target.EntireRow.Address).Cut Blad2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Target.NumberFormat = "ddd, dd mmm yyyy"
    End If
End If
Application.EnableEvents = True
End Sub

Blad2:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 Then
    If Target.Value >= Date Then
        Range(Target.EntireRow.Address).Cut Blad1.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
       Target.NumberFormat = "ddd, dd mmm yyyy"
    End If
End If
Application.EnableEvents = True
End Sub

 

[JeroenvanBaekel]

Harry,

De opmaak wordt wel meegekopiëerd, maar de "achtergebleven rij" (in Blad 1) verliest de opmaak in kolom B.
Zie de rijen 6, 17 en 24 op Blad 1 in bijgevoegd bestand.

Evengoed bedankt voor jouw hulp.

Groet,

Jeroen

 

[HSV]

Vreemd dat target.address steeds maar $B$7 wordt.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 Then
    If Target.Value < Date Then
    traddress = Target.Address
        Range(Target.EntireRow.Address).Cut Blad2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Range(traddress).NumberFormat = "ddd, dd mmm yyyy"
    End If
End If
Application.EnableEvents = True
End Sub

 

[JeroenvanBaekel]

Harry,

Bedankt! Deze oplossing werkt!

Groet,

Jeroen