Tekst kopieren en automatisch datum toevoegen.

[Robert Smidt]

Hallo beste helpmijers,

Ik ben opzoek naar een code die - wanneer cel AE2 is gevuld - deze de tekst kopieert naar cel AF2 en vervolgens een spatie en de datum (van vandaag) vermeld afgesloten met een (.
Echter wanneer er in cel AF2 al een tekst staat moet de nieuwe tekst er aan toegevoegd worden. Tenslotten kan de tekst in cel AE2 verwijderd worden.

Voorbeeld (oud)
AE2.................................AF2
......................................Telefonisch contact 20-9-2012;

(Nieuw)
AE2.................................AF2
Brief verstuurd...................Telefonisch contact 20-9-2012;

(macro activeren)
AE2.................................AF2
......................................Telefonisch contact 20-9-2012; brief verstuurd 22-9-2012;

Alvast hartelijk bedankt.

Met vriendelijke groet,
Robert Smidt

 

[RvanGalenLast]

Robert,

Omdat ik vermoed dat er meer cellen in kolom AE gecontroleerd moeten worden heb ik de code daar op aangepast. De code loopt alle gevulde cellen in kolom AE langs en voert de gevraagde actie uit.

Sub ActieVastleggen()
Dim i As Long, j As Long
    i = Columns(31).SpecialCells(xlTextValues).Count
    j = Cells(1, 31).End(xlDown).Row
    For c = 1 To i
        If IsEmpty(Cells(j, 32)) Then
            Cells(j, 32) = Cells(j, 31) & " " & Date & ";"
        Else: Cells(j, 32) = Cells(j, 32) & " " & Cells(j, 31) & " " & Date & ";"
        End If
    Cells(j, 31).ClearContents
    j = Cells(j, 31).End(xlDown).Row
    Next
End Sub

 

[RvanGalenLast]

Robert, ik heb de code iets aangepast.

Sub ActieVastleggen()
Dim c As Variant
Dim r As Range
Set r = Range("AE2:AE65536")
    For Each c In r.SpecialCells(xlTextValues)
        If IsEmpty(Cells(c.Row, 32)) Then
            Cells(c.Row, 32) = Cells(c.Row, 31) & " " & Date & ";"
        Else: Cells(c.Row, 32) = Cells(c.Row, 32) & " " & Cells(c.Row, 31) & " " & Date & ";"
        End If
    Cells(c.Row, 31).ClearContents
Next
End Sub

 

[snb]

Sub snb_004()
    [AF2:AF200] = [if(AE2:AE200="",AF2:AF200,trim(AF2:AF200&" "&AE2:AE200&" "&text(today(),"dd-mm-yyyy")&";"))]
    [AE2:AE200] = ""
End Sub

 

[Robert Smidt]

bedankt

Ronald,

Bedankt voor jouw snelle reactie, de code werkt perfect, echter is het niet de bedoeling dat hij de hele kolom bijlangs gaat, maar in dit geval maakt het niet uit, de kolom staat verder toch leeg.

Nogmaals bedankt en een fijn weekend.

Met vriendelijker groet,
Robert