zelfde macro maar juiste andere cellen

[glda19]

Weet niet of het mogelijk is een macro zo te maken dat ik meerdere x de zelfde macro kan laten uitvoeren maar met ander cel of colommen

dit heb ik nu

'Kopiëren van ziekte dagen vorige jaar en  jaartal vorig jaar
Worksheets("datablad").Range("j" & intLaatsteRij).Formula = CStr("=Year(Now()) - 1") 'Jaartal vorig jaar bij ziekte
If IsEmpty(Worksheets("datablad").Range("c33")) Then
    Worksheets("datablad").Range("m" & intLaatsteRij).Value = 0
Else
    Worksheets("datablad").Range("c33").Copy Destination:=Worksheets("datablad").Range("K" & intLaatsteRij)
End If
        
' Kopiëren van dagen werkongeval vorig jaar
If IsEmpty(Worksheets("datablad").Range("c46")) Then
    Worksheets("datablad").Range("n" & intLaatsteRij).Value = 0
Else
    Worksheets("datablad").Range("c46").Copy Destination:=Worksheets("datablad").Range("n" & intLaatsteRij)
        End If

 

[edmoor]

Geef de andere cel of kolommen als parameter mee aan de betreffende macro.

 

[glda19]

thx maar dat gaat niet wat je zei edmoor daar het in de zelfde sub gebeurt en die sub niet meer keren word aangesproken

heb het zo opgelost

strKolomJaar = "j"
strKolomWaarde = "k"
intLaatsteRij = Worksheets("datablad").Cells(Rows.Count, "j").End(xlUp).Offset(1, 0).Row
For Each elkecel In Range("c33,c46")
    Worksheets("datablad").Range(strKolomJaar & intLaatsteRij).Formula = CStr("=Year(Now()) - 1") 'Jaartal vorige jaar bij werkongeval
    'strCelAdres = strKolomWaarde & intLaatsteRij
   ' t = elkecel.Address
        If IsEmpty(Worksheets("datablad").Range(elkecel.Address)) Then
            Worksheets("datablad").Range(elkecel.Address).Value = 0
    Else
        Worksheets("datablad").Range(elkecel.Address).Copy Destination:=Worksheets("datablad").Range(strKolomWaarde & intLaatsteRij)
    End If
    If elkecel.Address = "$C$46" Then Exit For
strKolomJaar = "m"
strKolomWaarde = "n"
Next

 

[edmoor]

Lekker duidelijk dan.

...dat ik meerdere x de zelfde macro kan laten uitvoeren maar met ander cel of colommen