VBA répétition du code en fonction d'une cellule qui varie

Bonjour au forum

J'ai utilisé la macro suivante (c'est juste un extrait) pour 50 enregistrements et j'ai donc répété 50 fois la même macro ! Elle fonctionne mais.... un peu long à créer.

Comment écrire une macro pour :

- prendre le nom suivant à partir d'une liste (liste déroulante ou liste à part sans doublon)

et exécuter les différentes macros SANS avoir à la réécrire autant de fois qu'il y a de noms ?

 Sheets("Liste générale").Range("donnees[#All]").AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Range("B6:B7"), CopyToRange:=Range( _
        "B9:G9"), Unique:=True
'

("donnees[#All]) étant la base de données et B7 la liste déroulante comportant les noms sans doublons de la base.

et voici le code complet que je souhaite reproduire : ActiveCell.FormulaR1C1 = "1", "2", "3" etc mais aussi avec une liste de nom.

 Range("J2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("J2").Select
 
'on filtre selon l'activité - équivaut à filtre avancé
Sheets("Liste générale").Range("donnees[#All]").AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Range("J1:K2"), CopyToRange:=Range( _
        "A8:G8"), Unique:=True
    ActiveWindow.SmallScroll Down:=-28
    Range("J2").Select

   
'feuille en cours est copiée dans un nouveau classeur
 Sheets("par activité sans mail").Select
    Sheets("par activité sans mail").Copy
    Columns("A:G").Select
    Range("A3").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("H:Q").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
      
'enregistrement au format pdf
 lastRow = [LOOKUP(2,1/(A1:A65536<>""),ROW(A1:A65536))]

ActiveSheet.PageSetup.PrintArea = "A1:G" & Range("A" & Rows.Count).End(xlUp).Row 'plage de cellule à enregistrer a adapter
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
     "C:\Users\karin\OneDrive\Bureau\UIA-listing\" & Range("G2").Value & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

ActiveWorkbook.Close False 'On ferme le nouveau classeur

J'ai déjà bien cherché sur le net. 

Merci à vous toutes et tous qui contribuez à nous aider,  nous les novices (plus ou moins !),
Windows / Edge 107.0.1418.35