XL 2013 Créer macro en automatique

isataz

XLDnaute Nouveau
Bonjour,

je cherche à générer des macros de façon automatique.

voici à quoi ressemble ma macro :

Sub IP_xxxxx ()

Sheets("xxxxx").Select
Cells.Find(What:="IP_xxxxx", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("CLIENT").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(2, 0).Select
ActiveSheet.Paste
Sheets("xxxxx").Select
Application.CutCopyMode = False
End Sub


Je vais devoir copier-coller 197 fois cette macro et à chaque fois, la seule chose qui change c'est "IP_xxxxx".
J'ai la liste de tout les "IP_xxx" à faire.

Existe-t-il un moyen de ne pas faire 197 copier/coller? déjà que je vais devoir faire 197 boutons...

Merci par avance pour votre aide !

Isabelle
 

vgendron

XLDnaute Barbatruc
bonjour
et pourquoi ne pas écrire UNE Seule macro que tu appelles avec le XXXX
VB:
[I]Sub IP_xxxxx (NomFeuille as string)

Sheets([I]NomFeuille[/I]).Select
Cells.Find(What:="IP_" &NomFeuille, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("CLIENT").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(2, 0).Select
ActiveSheet.Paste
Sheets([I]NomFeuille[/I]).Select
Application.CutCopyMode = False
End Sub[/I]
[I]

selon le bouton cliqué, tu récupères son nom, et tu appelles la macro
exemple: je présume que tu as un bouton par feuille
Bouton 1111 sur la feuille 1111
==> quand tu cliques sur le bouton 1111
le code récupère son nom... en déduit 1111 et appelle la macro
call IP_xxxx(1111)

bon.. pour la suite et etre plus clair, il faudrait que tu postes ton fichier (du moins un bout en exemple)
[/I]
 

isataz

XLDnaute Nouveau
Bonjour et merci beaucoup pour ta réponse !
L'idée d'une seule macro me va très bien :)
Il s'agit de remises de prix clients, il y aura un onglet par marque et donc dans mon premier onglet j'ai 197 produits de la même marque.
A côté de chaque produit, je mets un bouton pour que le commercial puisse copier le prix remisé vers l'onglet client qui sera par la suite transformé en PDF.
Merci encore !
 

Pièces jointes

  • exemple fichier.xlsm
    48.7 KB · Affichages: 25

vgendron

XLDnaute Barbatruc
Re
meme pas besoin de bouton en fait.. il te suffit d'écrire "Copier" en colonne N sur la première ligne de chaque bloc
pour éviter de copier plusieurs fois, j'ai ajouté une ligne de code qui modifie "Copier" en "Déjà Copié"
voir PJ
 

Pièces jointes

  • exemple fichier.xlsm
    50.6 KB · Affichages: 31

vgendron

XLDnaute Barbatruc
Hello
nouvelle PJ
j'ai modifié le code (le premier ne me plaisait pas, car obligé d'activer et sélectionner pour coller)
la.. ca se fait en une ligne sans changer de fenetre

du coup.. dans tes autres onglets, tu as juste à copier la partie
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 14 And Target = "Copier" Then
    Call IP(Target.Row)
End If
End Sub
dans chaque feuille

et j'ai ajouté un bouton (et code associé) pour réinitialiser
Réinitialiser = remettre "Copier"dans la colonne N
et effacer la feuille "Client"
 

Pièces jointes

  • exemple fichier.xlsm
    52 KB · Affichages: 28

vgendron

XLDnaute Barbatruc
C'est à cause de la detection de fin de bloc à copier..
est ce que le nombre de lignes dans chaque bloc est constant? toujours 4 ? (à part le premier)
est ce que au sein d'un bloc, une colonne est forcément remplie sur TOUTES les lignes?
 

vgendron

XLDnaute Barbatruc
Sinon, en supposant que Tous tes blocs commencent par le NOM de la feuille (ici ImagePerfect), tu peux utiliser ce code à la place du précédent

VB:
Sub IP(ligne As Integer)
Application.EnableEvents = False 'on désactive les évènements
Application.ScreenUpdating = False 'on désactive le rafraichissement de  la feuille
With ActiveSheet 'dans la feuille active
    Set Fin = .Range("B" & ligne & ":B65536").Find(.Name, lookat:=xlPart) 'recherche de la prochaine ligne de colonne B qui contient le nom de la feuille
    If Not Fin Is Nothing Then 'si on trouve
        .Range("A" & ligne & ":M" & Fin.Row - 2).Copy Destination:=Sheets("CLIENT").Range("A" & .Rows.Count).End(xlUp).Offset(2, 0) 'on copie colle le bloc à la fin de la feuille CLIENT
        Application.CutCopyMode = False
        .Range("N" & ligne) = "Déjà Copiée" 'on passe la colonne N en Déjà copiée
     End If
End With
Application.EnableEvents = True 'on réactive
Application.ScreenUpdating = True
End Sub
 

vgendron

XLDnaute Barbatruc
Correction pour traiter le cas du dernier bloc
VB:
Sub IP(ligne As Integer)
Application.EnableEvents = False 'on désactive les évènements
Application.ScreenUpdating = False 'on désactive le rafraichissement des feuilles
With ActiveSheet
    Set BlocSuivant = .Range("B" & ligne & ":B65536").Find(.Name, lookat:=xlPart) 'recherche de la prochaine ligne de colonne B qui contient le nom de la feuille
    If Not BlocSuivant Is Nothing Then 'si il y a quelque chose
        If BlocSuivant.Row = ligne Then 'si on retrouve le bloc en cours (==on est sur le dernier bloc
            Fin = .UsedRange.Rows.Count + 5 'on met la dernière ligne de la feuille
        Else
            Fin = BlocSuivant.Row - 2 'sinon on récupère la ligne -2 pour remonter dans le bloc en cours
        End If
           
        .Range("A" & ligne & ":M" & Fin).Copy Destination:=Sheets("CLIENT").Range("A" & .Rows.Count).End(xlUp).Offset(2, 0) 'on copie colle
        Application.CutCopyMode = False
        .Range("N" & ligne) = "Déjà Copiée"
     End If
End With
Application.EnableEvents = True 'on réactive
Application.ScreenUpdating = True
End Sub
 

isataz

XLDnaute Nouveau
Les blocs font au mini 2 lignes mais montent à plus de 4 lignes.
Et en effet, au sein d'un bloc il peut y avoir des cellules vides.

Par contre, j'ai toujours une erreur dès que je sélectionne plus d'une cellule.
Ce qui veut dire que quand je sélectionne la case où il faut rentrer le % de remise, j'ai l'erreur "Run-time error '13' Type mismatch"

Après ça, j'arrête de te harceler !
 

vgendron

XLDnaute Barbatruc
remplace le code par celui ci: il y a un controle sur le nombre de cellules sélectionnées
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count <> 1 Then Exit Sub
If Target.Column = 14 And Target = "Copier" Then
    Call IP(Target.Row)
End If
End Sub
 

Discussions similaires

Réponses
2
Affichages
702