doorvoeren formule in vba

[westra77]

hallo
onlangs een topic geopend met de vraag of het mogelijk is om verschillende opmaak in 1 cel te verkrijgen. Wigi heeft hier een fantastische oplosssing voor gevonden.
ik heb de formule iets aangepast. ik wil nl dmv een macro knop de opmaak in verschillende cellen veranderen.
nu wordt in het bestand a6 en b6 in de cellen d6:d10 weergegeven.
de bedoeling is dat a6 en b6 weergegeven worden in d6
a7 en b7 in d7 enz.
zie vb

Sub fff()

    With Range("d6:d10") (orgineel was With Active cell)
    
        If Len(Range("B" & .Row).Value) = 0 Then
        
            .ClearContents
            
        Else
        
            .Value = Range("A" & .Row).Value & "(" & Range("B" & .Row).Value & ")"
            .Characters(Len(Range("A" & .Row).Value) + 2, Len(Range("B" & .Row).Value)).Font.Bold = True
            .Characters(Len(Range("A" & .Row).Value) + 2, Len(Range("B" & .Row).Value)).Font.Size = 8
            

        End If
    
    End With

End Sub

graag hoop ik een voorzet in de goede richting te krijgen, zodat ik deze zelf verder uit kan werken.
alvast bedankt!

 

[Ginger]

Westra77, Wat denk je van zoiets?

Sub fff()
Dim c As Range
    
    For Each c In Range("d6:d10")
        With c
            If Len(Range("B" & .Row).Value) = 0 Then
                .ClearContents
            Else
                .Value = Range("A" & .Row).Value & "(" & Range("B" & .Row).Value & ")"
                .Characters(Len(Range("A" & .Row).Value) + 2, Len(Range("B" & .Row).Value)).Font.Bold = True
                .Characters(Len(Range("A" & .Row).Value) + 2, Len(Range("B" & .Row).Value)).Font.Size = 8
            End If
        End With
    Next c

End Sub

Groet, Leo

 

[westra77]

bedankt, werkt perfect en begrijpelijk