Est-il possible de créer des macros à la chaîne ? [Résolu/Fermé]

Signaler
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016
-
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016
-
Bonjour,

Bernard, 40 ans et toutes mes dents ...

Je planche en ce moment au boulot sur un fichier excel qui est sensé nous faciliter la vie. Je préfère vous expliquer le contexte ainsi la réponse sera (peut-être) plus aisé. Je contrôle des Ethylotests d'Anti-Démarrage sur des bus, cette vérification se passe chaque année pour chaque bus. Pour cela, je dois tenir un registre et aussi fournir pour chaque véhicule (et il y en a beaucoup beaucoup), un Rapport de Vérification (pour moi) et une Attestation de vérification (pour le client).

Au début, j'ai créé 2 fichiers excel, 1 pour le registre et 1 pour le rapport/attestation. Mais devant le nombre conséquent d'intervention, j'ai pensé automatisé un maximum cette saisie de nombreuses données.

Je bute aujourd'hui sur plusieurs problèmes, mais le plus dur à résoudre pour moi, c'est Comment reproduire une macro pour plusieurs lignes ?
En fait, dans mon registre, à la fin de chaque ligne, j'ai créé un bouton associé à une macro qui me copie toutes les infos que j'ai renseigné dans cette ligne du registre et dont j'ai besoin dans le rapport/attestation. Quand je clique sur le bouton, ça envoie tout dans une autre feuille du fichier excel avec la mise en page qui va bien.
Je veux donc créer plusieurs macros (une pour chaque ligne). Ou alors est-il possible de créer une macro qui détecterai "automatiquement" la dernière ligne renseignée dans le registre afin d'en copier les données vers le rapport/attestation.

J'espère être clair :p

Voilà ma macro que j'ai appelé Rec1,
Sub Rec1()
    Range("A9,B9,C9,D9,E9,F9,G9,H9,I9,K9,M9").Select
    Range("M9").Activate
    Selection.Copy
    Sheets("RAPPORT VP").Select
    Range("BN1").Select
    ActiveSheet.Paste
    Range("V13:AC13").Select
End Sub



Félicitations à ceux qui ont réussi à venir à bout de mon petit pavé :)

Merci d'avance.

9 réponses

Messages postés
16311
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
26 novembre 2020
3 079
Bonjour

tu peux faire ca avec un seul bouton qui transfèrera tout en 1 fois

c'est bien les cellules colonne A à M (sauf J et L) que tu veux recopier ?

combien de lignes concernées ( 500, 1000, 10000...) ?

Si je regarde ta macro, il ne s'agit pas de 2 fichiers mais de 2 feuilles du même classeur


au besoin
Mettre le classeur (ou estrait) sans données confidentielles en pièce jointe sur https://www.cjoint.com/
et coller le raccourci par un clic droit sur le lien proposé dans le message de réponse

Dans l’attente
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Oui en fait pendant 2 ans, on a utilisé 2 fichiers et c'est aujourd'hui que je souhaite tout faire en un seul ;)
Messages postés
15430
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 novembre 2020
1 406
Bonjour,

Ou alors est-il possible de créer une macro qui détecterai "automatiquement" la dernière ligne renseignée dans le registre afin d'en copier les données vers le rapport/attestation.
Oui et avec un seul bouton a mettre sur la feuille rapport/attestation, dans format, propriete, decocher: Imprimer l'objet

nom de feuille et premiere ligne d'info (ici derlig=2) a adapter

Sub Bouton1_Cliquer()
    With Worksheets("Registre")
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        If derlig < 2 Then derlig = 2
        TInfos = .Range("A" & derlig & ":M" & derlig)
    End With
    With Sheets("RAPPORT VP")
        .Range("BN1").Resize(, 13) = TInfos
        .Range("V13:AC13").Select
    End With
End Sub
Messages postés
16311
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
26 novembre 2020
3 079
F89:

On ne recopie pas les cellules colonnes J et L....
Messages postés
15430
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 novembre 2020
1 406 >
Messages postés
16311
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
26 novembre 2020

Bonjour,

Ok, juste une petite modif

'c'est bien les cellules colonne A à M (sauf J et L)
Sub Bouton1_Cliquer()
    With Worksheets("Registre")
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        TInfos = .Range("A" & derlig & ":I" & derlig)
    End With
    With Sheets("RAPPORT VP")
        .Range("BN1").Resize(, 9) = TInfos
        .Range("BX1") = Worksheets("Registre").Range("K" & derlig)
        .Range("BZ1") = Worksheets("Registre").Range("M" & derlig)
        .Range("V13:AC13").Select
    End With
End Sub
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Oui, c'est bien ça. Et c'est sur 1500 lignes ;)
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Je viens de tester; ça marche presque parfaitement, à première vue quelques infos qui ne sont pas au bon endroit. mais c'est très encourageant :p
Messages postés
15430
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 novembre 2020
1 406 >
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Re,

Justement, voir f894009 16 mars 2016 à 15:29
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Oh purée !! Vous êtes payés pour répondre aussi vite et avec autant de solutions :p ?

J'entrevoie de belles pistes dans vos soluces, mais pour info je vous envoi quand même le fichier. C'est un p'tit peu mon "oeuvre d'art", car je suis vraiment néophyte sur Excel.

http://www.cjoint.com/c/FCqm7pGY4qu

Encore merci !!

ps : j'ai oublié de préciser que mes camarades de travail sont des "b**nes" en informatique. Et comme ils font pleins d'erreurs de saisie, voilà le pourquoi du comment.
Messages postés
15430
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 novembre 2020
1 406
Re,

Votre ficher modifie: https://www.cjoint.com/c/FCqoC7Db4jf
Messages postés
15430
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 novembre 2020
1 406 >
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Bonjour,

Ok, je regarde la chose

Sur quel excel travaillez vous, votre fichier d'origine est un xls et y a pas de boite dialogue projet VB ??

A+
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Excel 2010, en fait je voulais plutôt dire à la place de "Est-il possible de faire en sorte qu'il n'y est pas de boite de dialogue qui s'ouvre ?", c'est que j'aimerai qu'il n'y est pas de pop up qui me demande si oui ou non je veux enregistrer avec les macro, je veux uniquement le rapport/attestation avec les données, limite sans formule.
Messages postés
15430
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 novembre 2020
1 406 >
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Re,

premiere muture:

ajoutez un bouton sous bouton recup, mettre le code dans un module et affectez ce code a ce bouton
le nom du fichier est celui du client, adaptez le chemin

'sauvegarde rapport
Sub Bouton545_Cliquer()
    Sheets("RAPPORT VP").Select
    Fichier = Range("BP1") & ".xls"         'nom du client
    Chemin = "C:\Users\SWF\Downloads\"
    Sheets("RAPPORT VP").Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=Chemin & Fichier, _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Close
    Windows("Somum_TEST.xls").Activate
    Application.DisplayAlerts = True
End Sub


Je regarde pour votre demande
uniquement le rapport/attestation avec les données, limite sans formule.

Me semble complique a cause de la mise en page et des incrustations logo
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Je test ça quand j'ai 5 minutes, là c'est le feu dans l'atelier !
:p
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Re Bonjour, après cette longue pause.

Je remercie encore tous les contributeurs à ce post, je planche encore sur mon fichier, qui atteindra bientôt sa finalisation. Il me reste 2 ou 3 points à terminer, mais je créerai un autre Sujet car ma question sera tout autre.
En tous cas mes attentes ont étaient comblé par vos conseils.

Merci !!
Messages postés
1978
Date d'inscription
mercredi 27 juillet 2005
Statut
Membre
Dernière intervention
28 septembre 2020
821
Bonjour à tous,

Une petite alerte sur le contenu des fichiers échangés.
Il y a des noms, des immatriculations, des modèles d'attestation avec cachet...
Ça ne me semble pas raisonnable de laisser ce genre de fichier en ligne.

Cordialement
Messages postés
15430
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
24 novembre 2020
1 406
Bonjour,

Eh oui! Il semblerait que quelques personnes soient iimprudentes
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Ce sont des immat' au hasard. Rien n'est privé dans les données, hormis nos noms et le tampon, j'avoue :(

Edit : J'ai effacé, merci.
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016

Merci beaucoup à tous pour vos réponses :)
Messages postés
19
Date d'inscription
vendredi 11 mars 2016
Statut
Membre
Dernière intervention
16 mars 2016

Bonjour Bernard,

Il te suffit d'associer la même macro à tous tes boutons.

Par contre, il te faudra peut tester la ligne du bouton sur lequel tu as appuyé avec l'instruction

'Récuperation de l'adresse du bouton
cellule = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address

Attention, l'adresse sera de la forme $H$6 pour H6.

A toi ensuite d'adapter ta macro et de remplacer les cellules en dur par rapport à la ligne sur laquelle tu étais.

Pour récupérer le numéro de ligne à partir de l'adresse, tu peux faire :


'Détermination de la ligne à modifier
For i = 1 To Len(cellule)
If IsNumeric(Mid(cellule, i, 1)) Then
nombre = Val(Mid(cellule, i, Len(cellule) - i + 1))
num_ligne = nombre
i = Len(cellule)
End If
Next

J'espère que cela répond à ton problème.
Bonjour
voila déjà une modife de ta macro
Sub Rec1()
   Range("A9,B9,C9,D9,E9,F9,G9,H9,I9,K9,M9").Copy
      Sheets("RAPPORT VP").Range("BN1").PasteSpecial xlPasteValues
   Application.CutCopyMode = False
End Sub

A+
Maurice
Bonjour
pour copier la dernier ligne
Sub RecLigne()
   L = Sheets("REGISTRE").Cells(Rows.Count, 2).End(xlUp).Row
      Sheets("REGISTRE").Range("A" & L & ":I" & L & ",K" & L & ",M" & L).Copy
   Range("BN1").PasteSpecial xlPasteValues
   
   With Application
      .CutCopyMode = False
      .Goto [A1], True
   End With
End Sub

A+
Maurice