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

Fermé
kaetl - Modifié le 7 nov. 2022 à 01:55
cs_Le Pivert Messages postés 7902 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 novembre 2023 - 15 nov. 2022 à 16:44

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

A voir également:

3 réponses

cs_Le Pivert Messages postés 7902 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 novembre 2023 728
7 nov. 2022 à 09:37

Bonjour,

Avec la fonction Arguments multiples

voir ceci


0

Merci Pivert pour ta réponse. 

Je vais voir cela. Ne connaissant pas très bien le VBA, il me faut un peu de temps.

Si résolu, où dois-je mettre l'info?

0
cs_Le Pivert Messages postés 7902 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 novembre 2023 728
15 nov. 2022 à 16:44

Dans ta demande, initiale clique sur les 3 petits points en bas à droite. ensuite clique sur Marquer comme résolu

@+ Le Pivert

0

Merci Pivert

je vais voir cela. Connaissant très peu le VBA, il me faut un peu de temps.

0