Remplissage d'une cellule vide dans boucle For

Bonjour,

Je suis confronté à un problème auquel je n'arrive pas à trouver la solution toute seule et je vous serais très très reconnaissante si vous pourriez m'aider.

Je suis en train de faire une macro qui me permette de gérer une base client. En gros j'ai deux feuille "Base" qui correspondent à une base client avec les données sur les différents clients et un autre fichier "Base étude" avec les nouveaux produits pour lesquels les clients sont prospectés. Sur la ligne de chaque client dans la feuille "Base" il y a 5 cellules, les colonnes (R:V), qui correspondent aux produits en prospection. J'ai déjà créé un Userform qui me permet pour chaque nouveau produit créé, de l'associer à des clients. J'aimerais qu'à chaque rajout de nouveau produits, une macro vienne trouver le client que je souhaite mettre à jour, et qu'elle trouve quelle cellule dans la plage (R:V) du client est vide afin d'y coller le nouveau produit prospecté.
La macro que j'ai créée fonctionne mais au lieu de copier le nom du nouveau produit sur la première cellule vide, elle l'étend à toutes les cellules vides des colonnes (R:V).

Voici mon code:

For r = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(r) = True Then

For c = 1 To ListBox1.ColumnCount - 14
Sheet5.Cells(4 + Range("Compteur2"), c + 3).Value = ListBox1.List(r, c)

Sheets("Base étude").Select
Cells(3 + Range("Compteur2"), 4).Select
Selection.Copy
Sheets("Feuille sup").Select
Range("B42").Select
Selection.PasteSpecial paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Range("B43").Value = TextBox1.Value
Range("B43").Select
Selection.Copy

Sheets("Base").Select
If (Cells(2 + Range("numéro"), 18)) = "" Then
Cells(2 + Range("numéro"), 18).Select
Selection.PasteSpecial paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ElseIf IsEmpty(Cells(2 + Range("numéro"), 19)) Then
Cells(2 + Range("numéro"), 19).Select
Selection.PasteSpecial paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ElseIf IsEmpty(Cells(2 + Range("numéro"), 20)) Then
Cells(2 + Range("numéro"), 20).Select
Selection.PasteSpecial paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ElseIf IsEmpty(Cells(2 + Range("numéro"), 21)) Then
Cells(2 + Range("numéro"), 21).Select
Selection.PasteSpecial paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ElseIf IsEmpty(Cells(2 + Range("numéro"), 22)) Then
Cells(2 + Range("numéro"), 22).Select
Selection.PasteSpecial paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

End If
Next c

End If
Next r

Sheets("Base étude").Select
Range("Q5").Copy
Range("Q6:Q70000").Select
Selection.PasteSpecial paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select

J'espère avoir été claire!

Merci d'avance

Cordialement,

Silvia