Doelzoeken macro meerdere cellen met overslaan lege cellen

[DjoeZty]

Hallo,

Ik heb een macro gevonden voor doelzoeken, zie bijlage.
De macro gaat uit van de geselecteerde startcel en werkt via shortcut ctrl+d.
Hij werkt perfect, per rij.

Ik krijg nu grotere bestanden met meer rijen, waardoor ik de macro telkens per regel aan moet roepen.
Dit is toch ook te automatiseren via een loop?
Ik heb het geprobeerd, maar ik krijg het niet voor elkaar.

Misschien willen/kunnen jullie helpen?

uitgangspunten:
1) starten bij de geselecteerde cel
2) lege cellen overslaan
3) lopend tot de laatste cel in de kolom

Bij voorbaat heeeeel veel dank!

MVG,
DjoeZty

 

[edmoor]

Probeer deze eens:

Sub Doelzoeken()
    Column = ActiveCell.Column
    
    With ActiveSheet
        Lastrow = .Cells(.Rows.Count, Column).End(xlUp).Row
    End With
    
    For i = ActiveCell.Row To Lastrow
        If Cells(i, Column) <> "" Then
            Cells(i, Column).GoalSeek Goal:=Range("C3"), ChangingCell:=Cells(i, Column - 1)
        End If
    Next i
End Sub

 

[DjoeZty]

Werkt perfect!!

Hartelijk bedankt