Compteur macro

erikess

XLDnaute Junior
Bonjour,

J'ai une macro qui fonctionne très bien sauf que je suis obligé de la lancer client par client par un bouton dédié sur la feuille excel.
En gros la macro prend un n° de client dans une liste et le colle sur le 1er onglet.
Le détail de ce client s'affiche alors sur l'onglet "compte" et le total sur un troisième onglet "lcr". Les 3 feuilles sont éditées puis le 1er n° de client de l'onglet liste est éliminé.

J'aimerai une macro qui répète ce travail tant que la liste des clients n'est pas à zéro.

Cependant j'aimerai pouvoir choisir le nombre de fois que la macro doit se faire quand je le souhaite.
(j'édite des documents donc mieux vaut ne pas se tromper si j'ai 100 clients !)

Merci beaucoup !

Un collègue m'avait proposé cette macro compteur :

Sub plusieurs_relances()
'
' Lancer_plusieurs_relances Macro
'
Dim Compteur As Long
For Compteur = 1 To 2
plusieurs_relances
Next Compteur
End Sub

Là ça aurait du éditer 2 clients...
 

Pièces jointes

  • test macro1.xlsm
    898 KB · Affichages: 75

JCGL

XLDnaute Barbatruc
Re : Compteur macro

Bonjour à tous,

Peux-tu essayer avec ceci :

VB:
Option Explicit


Sub Rappel_PDF()
    Dim Compteur&, DerL&
    DerL = Feuil5.Range("A65000").End(xlUp).Row
    For Compteur = 1 To DerL
    Range("A" & Compteur).Copy Sheets("Relance").Range("B14")
    Sheets("relevé").Select
    Range("A1").Select
    Range("A1:J338").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets _
     ("Relance").Range("B13:B14"), CopyToRange:=Range("A1000"), Unique:=False
    Range("A1000").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A1000:J1029").Cut Sheets("Compte").Range("A6")
Sheets("Relance").Select
    Range("E14").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    'ActiveWindow.SelectedSheets.PrintPreview
    Sheets("Compte").Select
    Range("D4").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    'ActiveWindow.SelectedSheets.PrintPreview
    Range("A6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A6:J35").Select
    Selection.EntireRow.Delete
Next Compteur
End Sub

A+ à tous
 

erikess

XLDnaute Junior
Re : Compteur macro

Hello merci pour la macro ! Ca fonctionne mais :
Le problème est que ça n'inscrit aucun n° de client sur la 1ère feuille "relance" en B14 d'après la liste de l'onglet "liste".
A partir de là aucun détail n'est reporté sur la page "compte".
Sinon il faudrait aussi que la page "lcr" s'édite
Je ne comprends pas trop le raisonnement de votre macro, pouvez-vous m'expliquer sa procédure ?

Merci et bonne journée !
 

JCGL

XLDnaute Barbatruc
Re : Compteur macro

Bonjour à tous,

Le problème est que ça n'inscrit aucun n° de client sur la 1ère feuille "relance" en B14 d'après la liste de l'onglet "liste".
Je regarde mais la liste des clients est avec liaison vers un autre fichier...
A partir de là aucun détail n'est reporté sur la page "compte".
Redéfini la zone d'impression...
Sinon il faudrait aussi que la page "lcr" s'édite
Je regarde mais la liste des clients est avec liaison vers un autre fichier...

A+ à tous
 

JCGL

XLDnaute Barbatruc
Re : Compteur macro

Bonjour à tous,

Peux-tu essayer avec :

VB:
Option Explicit 'Oblige à déclarer les variables et aide à la rédaction du code


Sub Rappel()
    Dim Compteur&, DerL& 'Déclaration des variables
    'Voir [I]Ce lien n'existe plus[/I]
    'Et [I]Ce lien n'existe plus[/I] pour les symboles
    DerL = Feuil5.Range("A65000").End(xlUp).Row 'Détermine la dernière valeur de la liste des Codes
    Application.ScreenUpdating = 0 'Annule le raifraichissement de l'écran
    Feuil3.Range("B17") = Now 'Pose la date du jour
    ActiveWorkbook.Worksheets("Relevé").Names("Extract").RefersToR1C1 = _
    "=Relevé!R1000C1:R1000C10" 'Créée la zone d'impression de la feuille Relevé
    For Compteur = 2 To DerL 'Détermine le Compteur de la ligne 2 à la dernière ligne
        Feuil5.Range("A" & Compteur).Copy Sheets("Relance").Range("B14") 'Copie la première valeur de Code de la Liste
        Sheets("Relevé").Select
        Range("A1").Select
        Range("A1:J1000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets _
          ("Relance").Range("B13:B14"), CopyToRange:=Range("A1000"), Unique:=False 'Création du filtre élaboré
        Range("A1000").Select
        Range(Selection, Selection.End(xlDown)).Select 'Sélectionne toute la plage utile
        Range("A1000:J1050").Cut Sheets("Compte").Range("A6") 'Coupe et copie en A6
        Sheets("Relance").Select
        Range("A1").Select
        'ActiveWindow.SelectedSheets.PrintOut Copies:=1
        ActiveWindow.SelectedSheets.PrintPreview 'Enlever l'apostrophe devant la ligne précédente pour imprimer
        Sheets("Compte").Select
        Range("H3").Formula = "=SUM(R[4]C10:R[47]C10)" 'Pose la formule du Total
        Range("H3") = Range("H3").Value 'Remplace la formule par sa valeur
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$50"
        Range("A1").Select
        'ActiveWindow.SelectedSheets.PrintOut Copies:=1
        ActiveWindow.SelectedSheets.PrintPreview 'Enlever l'apostrophe devant la ligne précédente pour imprimer
        Range("A6").Select
        Range(Selection, Selection.End(xlDown)).EntireRow.Delete 'Supprime les lignes du filtre élaboré
        Sheets("LCR").Select
        'ActiveWindow.SelectedSheets.PrintOut Copies:=1
        ActiveWindow.SelectedSheets.PrintPreview 'Enlever l'apostrophe devant la ligne précédente pour imprimer
    Next Compteur 'Passe à la deuxième ligne de la Liste
    Application.ScreenUpdating = 1 'Rétabli le rafraichissement de l'écran
End Sub






A+ à tous
 

Pièces jointes

  • JC Multi Relances 3 Feuilles.xlsm
    658.7 KB · Affichages: 61

Discussions similaires

Réponses
3
Affichages
303

Statistiques des forums

Discussions
312 347
Messages
2 087 504
Membres
103 565
dernier inscrit
Fabien78