Améliorer code

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
jacky49

jacky49

XLDnaute Impliqué
Bonjour le Forum,

J'ai ces code qui me servent à copier des données dans une feuille, je voudrais savoir s'il y a moyen de les raffaraichir( qu'ils soient moins gros ) et pour le moment, je les appelles avec un bouton formulaire, que faut-il ajouter pour qu'ils soient appeler avec bouton de contrôle active x.

merci
jacky


Code: 
Sub Copier()
'
' Copier Macro
'

'
    Range("A6:D11").Select
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Séries").Select
    Range("F6:I11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=12
    Sheets("Séries").Select
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    Range("K6:N11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Séries").Select
    Range("P6:S11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Séries").Select
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 18
    Range("U6:X11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C33").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=21
    Sheets("Séries").Select
    Range("Z6:AC11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C39").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Séries").Select
    Range("AE6:AH11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C45").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Séries").Select
    Range("AJ6:AM11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C51").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Séries").Select
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 34
    ActiveWindow.ScrollColumn = 35
    ActiveWindow.ScrollColumn = 36
    ActiveWindow.ScrollColumn = 37
    Range("AO6:AR11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MiniFilles").Select
    ActiveWindow.SmallScroll Down:=12
    Range("C57").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Séries").Select
    Range("AT6:AW11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Séries").Select
    Range("C63").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G3").Select
End Sub
 
Trier par date Trier par votes
Re : Améliorer code

re,

j'ai oublié les 2 autres codes.

Code: 
Sub Copier_DF()
'
' Copier_DF Macro
'

'
    Range("A6:D11").Select
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C69").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Demi-Finales").Select
    Range("F6:I11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C75").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I69").Select
    Sheets("Demi-Finales").Select
    Range("F3").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub
Sub Copier_F()
'
' Copier_F Macro
'

'
    Range("A5:D11").Select
    ActiveWorkbook.Worksheets("Finales").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Finales").Sort.SortFields.Add Key:=Range("D6:D11") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Finales").Sort
        .SetRange Range("A5:D11")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A6:D11").Select
    Selection.Copy
    Sheets("MiniFilles").Select
    Range("C81").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I81").Select
    Sheets("Finales").Select
    Range("F4").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub

merci
jacky
 
Vote positif 0 Vote négatif
Re : Améliorer code

Bonjour jacky49,
Voici un exemple de nétoyage de code. Je n'ai pas regarder exactement ce qu'il fait, mais vous verrez le principe général.
J'ai ajouté en rouge deux lignes que l'enregistreur ne vous donnnera pas. Elles servent à figer l'écran pendant le déroulement de la macro.
Code: 
Sub Copier()
[COLOR=red][B]Application.ScreenUpdating = False[/B][/COLOR]
     Sheets("Séries").Range("A6:D11").Copy
    Sheets("MiniFilles").Range("C9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Séries").Range("F6:I11").Copy
    Sheets("MiniFilles").Range("C15").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Séries").Range("K6:N11").Copy
    Sheets("MiniFilles").Range("C21").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Séries").Range("P6:S11").Copy
    Sheets("MiniFilles").Range("C27").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Séries").Range("U6:X11").Copy
    Sheets("MiniFilles").Range("C33").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Séries").Range("Z6:AC11").Copy
    Sheets("MiniFilles").Range("C39").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Séries").Range("AE6:AH11").Copy
    Sheets("MiniFilles").Range("C45").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Séries").Range("AJ6:AM11").Copy
    Sheets("MiniFilles").Range("C51").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Séries").Range("AO6:AR11").Copy
    Sheets("MiniFilles").Range("C57").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Séries").Range("AT6:AW11").Copy
    Sheets("MiniFilles").Range("C63").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Séries").Range("G3").Select
Application.CutCopyMode = False
[COLOR=red][B]Application.ScreenUpdating = True[/B][/COLOR]
End Sub
Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Améliorer code

Bonjour Jacky,

Me limitant à ceci : "savoir s'il y a moyen de les raffaraichir( qu'ils soient moins gros"

Que tes codes soient appelés par un contrôle x ou y, une image, une photo, une zone de texte je ne vois pas comment leur appliquer un régime minceur...

Peut être pas bien compris la question....

Bonne fin de journée.

Jean-Pierre
 
Vote positif 0 Vote négatif
Re : Améliorer code

Re, Bonjour Habitude,
jacky49:
Perso j'ai découvert pas mal de choses en enregistrant les macros. Par contre cela engendre des pièges (en dehors des lignes qui ne servent à rien). Par exemple dans la macro Copier_F, vous utilisez un filtre et vous copiez certaines cellules (Range("A6 : D11")), rien ne dit que la prochaine foi les données seront là...
Pour ce problème il faudrait fournir un fichier exemple.
Cordialement
 
Vote positif 0 Vote négatif
Re : Améliorer code

Bon soir,

un autre code pour la première macro :
Code: 
Private Sub CommandButton1_Click()
  Dim Col As Byte, Li As Integer
 
  Application.ScreenUpdating = False
  With Sheets("MiniFilles")
    For Col = 1 To 46 Step 5
      Li = Li + 1
      Range(Cells(6, Col), Cells(11, Col + 3)).Copy
      .Cells(9 + 6 * Li, 3).PasteSpecial Paste:=xlPasteValues
    Next
  End With
  Application.CutCopyMode = False
  [G3].Select
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Améliorer code

re, le forum et tous,

Efgé, ton coode fonctionne à merveille,le code ne met pas longtemps, par contre Lii
, je n'arrive pas à faire fonctionner le tien, que ce soit avec un bouton formulaire( quand je veux affecter une macro, la tienne n'y est pas) et quand j'essaie avec un bouton active x, cela ne fonctionne pas non plus.
Donc, si vous pouviez tous les 2 améliorer mes 2 autres codes, ce serait super.
merci beaucoup
jacky
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

J
  • Résolu(e)
Microsoft 365 Collage valeur Erreur d'exécution 1004
Réponses
7
Affichages
218
Magic_Doctor
Magic_Doctor
J
  • Résolu(e)
Microsoft 365 Première cellule vide ou égal zéros dans une plage définie
Réponses
11
Affichages
458
juju91
J
F
Fdaga
Réponses
2
Affichages
136
dysorthographie
dysorthographie
arck
  • Résolu(e)
XL 2019 Renvoyé à la ligne suivante si la ligne demandé n'est pas libre
Réponses
9
Affichages
343
Phil69970
Phil69970
arck
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
646
AtTheOne
AtTheOne
ph.vanne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
791
ph.vanne
ph.vanne
N
  • Résolu(e)
Microsoft 365 Macro entre 2 classeurs
2
Réponses
19
Affichages
761
Nounours4173
N
F
Fdaga
Réponses
0
Affichages
191
Fdaga
F
richardlion
  • Question Question
XL 2016 copier valeur actuel
2
Réponses
18
Affichages
597
sylvanu
sylvanu
M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
1 K
MICHAEL
M
eastwick
  • Résolu(e)
XL 2016 macro fichier fermé
Réponses
1
Affichages
191
eastwick
eastwick
C
  • Question Question
Microsoft 365 Enregistrer via VBA sans ouvrir fichier
Réponses
9
Affichages
538
cdric78
C
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
1 K
Phil69970
Phil69970
M
  • Question Question
XL 2021 VBA Excel Erreur 2023
Réponses
2
Affichages
399
MICHIS
M
micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
697
micie1509
micie1509
M
  • Résolu(e)
Microsoft 365 Pouvez-vous traduire le code VBA SVP ?
Réponses
8
Affichages
432
MOLY_
M
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
803
robpellan52
R
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
3 K
job75
job75
G
  • Question Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
430
sylvanu
sylvanu
V
  • Question Question
XL pour MAC outil coller le contenu du presse papier
Réponses
2
Affichages
745
Valter
V
Retour