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

Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016
- - Dernière réponse : SOMUM
Messages postés
28
Date d'inscription
mardi 15 mars 2016
Statut
Membre
Dernière intervention
1 août 2016
- 6 avril 2016 à 09:19
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.

Afficher la suite 

9 réponses

Messages postés
16002
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
5 décembre 2019
2832
0
Merci
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 http://cjoint.com/
et coller le raccourci par un clic droit sur le lien proposé dans le message de réponse

Dans l’attente
SOMUM
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
14889
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 décembre 2019
1194
0
Merci
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
michel_m
Messages postés
16002
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
5 décembre 2019
2832 -
F89:

On ne recopie pas les cellules colonnes J et L....
f894009
Messages postés
14889
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 décembre 2019
1194 > michel_m
Messages postés
16002
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
5 décembre 2019
-
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
SOMUM
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 ;)
SOMUM
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
f894009
Messages postés
14889
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 décembre 2019
1194 > SOMUM
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
0
Merci
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
14889
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 décembre 2019
1194
0
Merci
Re,

Votre ficher modifie: http://www.cjoint.com/c/FCqoC7Db4jf
f894009
Messages postés
14889
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 décembre 2019
1194 > SOMUM
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+
SOMUM
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.
f894009
Messages postés
14889
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 décembre 2019
1194 > SOMUM
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
SOMUM
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
SOMUM
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
1938
Date d'inscription
mercredi 27 juillet 2005
Statut
Membre
Dernière intervention
16 août 2019
771
0
Merci
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
f894009
Messages postés
14889
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 décembre 2019
1194 -
Bonjour,

Eh oui! Il semblerait que quelques personnes soient iimprudentes
SOMUM
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
0
Merci
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
-1
Merci
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.
-2
Merci
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
-2
Merci
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