Microsoft 365 Optimisation code VBA - Succession de copier coller

F

flomag

XLDnaute Nouveau
Hello à tous,

Je me demande comment je pourrai optimiser le code suivant (réalisé avec l'enregistreur de macro) qui ne fait que des copier coller répétitifs dans une autre feuille.

Le point c'est que lorsque je lance macro cela fait scintiller l'excel et cela prend pas mal de temps.

Voici le code ci-après :

Sub Macro10()
'
' Macro10 Macro
'

'
Sheets("Synthèse").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.Font.Bold = True
Selection.Font.Bold = False
Sheets("IM").Select
Range("D5").Select
Selection.Copy
Sheets("Synthèse").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("N5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("N7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("N9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("N11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("N13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("N15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K17:N17").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("N2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K19:N19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("O2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K21:N21").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("P2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
ActiveWindow.SmallScroll Down:=12
Range("K23:N23").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("Q2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("N25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("S2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
Range("K27:O27").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Synthèse").Select
Range("T2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IM").Select
ActiveWindow.SmallScroll Down:=-21
Range("D5").Select
End Sub


Merci pour vos réponses :)
 
Trier par date Trier par votes
cp4

cp4

XLDnaute Barbatruc
Bonsoir,

Pour éviter le scintillement (Rafraichissement de l'affichage)
Mets cette ligne de code au début de ton code:
Application.ScreenUpdating = False

et à la fin
Application.ScreenUpdating = True

tu aurais pu joindre un petit fichier en expliquant ce que tu veux obtenir.
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
Bonjour @flomag

Edt : bonjour @cp4

C’est proprement indigeste ....;)
Il faut au minimum utiliser les balises....
1640015985945.png

Et un fichier c'est beaucoup mieux.....
En clair vous copiez quelles cellules et ou ?

@Phil69970
 
Dernière édition:
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
Re, bonsoir @Phil69970 ;)

@flomag : j'ai du ménage dans ta macro, tu ne fais pas que du copier/coller valeurs.
au début tu insère une ligne. Donc à tester
VB: 
Sub Macro10()
Application.ScreenUpdating = False
    Sheets("Synthèse").Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With


    Sheets("IM").Range("D5").Copy
    Sheets("Synthèse").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K5").Copy
    Sheets("Synthèse").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K7").Copy
    Sheets("Synthèse").Select
    Range("C2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                      :=False, Transpose:=False

    Sheets("IM").Range("K9").Copy
    Sheets("Synthèse").Range("D2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K11").Copy
    Sheets("Synthèse").Range("E2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K13").Copy
    Sheets("Synthèse").Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K15").Copy
    Sheets("Synthèse").Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("N5").Copy
    Sheets("Synthèse").Range("H2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("N7").Copy
    Sheets("Synthèse").Range("I2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("N9").Copy
    Sheets("Synthèse").Range("J2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("N11").Copy
    Sheets("Synthèse").Range("K2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("N13").Copy
    Sheets("Synthèse").Range("L2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("N15").Copy
    Sheets("Synthèse").Range("M2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K17:N17").Copy
    Sheets("Synthèse").Range("N2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K19:N19").Copy
    Sheets("Synthèse").Range("O2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K21:N21").Copy
    Sheets("Synthèse").Range("P2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K23:N23").Copy
    Sheets("Synthèse").Range("Q2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K25").Copy
    Sheets("Synthèse").Range("R2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("N25").Copy
    Sheets("Synthèse").Range("S2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False

    Sheets("IM").Range("K27:O27").Copy
    Sheets("Synthèse").Range("T2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                         :=False, Transpose:=False
Application.CutCopyMode = False   
Sheets("IM").activate
Range("D5").Select
Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
Re

Voici ma version en encore plus court

VB: 
Sub Macro10()
Application.ScreenUpdating = False
With Sheets("Synthèse")
    .Rows("2:2").Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("A2") = Sheets("IM").Range("D5")
    .Range("B2") = Sheets("IM").Range("K5")
    .Range("C2") = Sheets("IM").Range("K7")
    .Range("D2") = Sheets("IM").Range("K9")
    .Range("E2") = Sheets("IM").Range("K11")
    .Range("F2") = Sheets("IM").Range("K13")
    .Range("G2") = Sheets("IM").Range("K15")
    .Range("H2") = Sheets("IM").Range("N5")
    .Range("I2") = Sheets("IM").Range("N7")
    .Range("J2") = Sheets("IM").Range("N9")
    .Range("K2") = Sheets("IM").Range("N11")
    .Range("L2") = Sheets("IM").Range("N13")
    .Range("M2") = Sheets("IM").Range("N15")
    .Range("N2") = Sheets("IM").Range("K17")
    .Range("O2") = Sheets("IM").Range("K19")
    .Range("P2") = Sheets("IM").Range("K21")
    .Range("Q2") = Sheets("IM").Range("K23")
    .Range("R2") = Sheets("IM").Range("K25")
    .Range("S2") = Sheets("IM").Range("N25")
    .Range("T2") = Sheets("IM").Range("K27")
    .Range("A3:T3").Copy
    .Range("A2").PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
End With
End Sub

@cp4 :
Je pense qu'ici (et les suivantes ) il y a des cellules fusionnées
Sheets("IM").Range("K17:N17").Copy
Cliquez pour agrandir...

*Merci de ton retour @flomag

@Phil69970
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
bonsoir
l'idée de @Phil69970 est propre
néanmoins on la simplifie un peu et on peut se passer de de bloquer l’écran
en fait on copy tout d'un coup(sans copier bien sur((value=value)))
VB: 
Sub ouaip()
Dim ar
With Sheets("IM")
ar = Array(.[d5], .[k5], .[k7], .[k9], .[k11], .[k13], .[k15], .[n5], .[n9], .[n11], .[n13], .[n15], .[k17], .[k19], .[k21], .[k23], .[k25], .[n25], .[k27])
End With
With Sheets("Synthèse")
    .Rows("2:2").Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("A2:T2") = ar
        .Range("A3:T3").Copy
    .Range("A2").PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
End With
End Sub
 
Vote positif 0 Vote négatif
F

flomag

XLDnaute Nouveau
Bonjour à tous,

Merci bcp pour vos réponses, cela fonctionne très bien avec le VBA de @patricktoulon !
Bien plus clair en effet.

Je vous joins le fichier que je travail en parallèle pour que vous puissiez y jeter un œil.

J'ai un nouveau problème sur l'actualisation de mes zones de liste dans le panneau de contrôle Orange.

Lorsque je change le texte dans le panneau de contrôle bleu à gauche je suis obligé de cliquer sur une zone de liste pour voir le résultat actualisé.. Ce qui est un peu frustrant. J'aimerai que lorsque je fais une modification dans la zone bleue la première sélection de la zone de liste (panneau orange) s'actualise directement.

Possible d'ajouter cela dans le VBA vous pensez ?

Merci bcp pour votre aide !

Bien à vous,
 

Pièces jointes

  • Outil VAB FTH_macro test3.xlsm
    179.5 KB · Affichages: 5
Vote positif 0 Vote négatif

Discussions similaires

ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
430
ph.vanne
ph.vanne
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
327
Phil69970
Phil69970
M
  • Question
XL 2021 VBA Excel Erreur 2023
Réponses
2
Affichages
192
MICHIS
M
micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
308
micie1509
micie1509
M
  • Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
16
Affichages
704
Phil69970
Phil69970
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
530
robpellan52
R
G
  • Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
174
sylvanu
sylvanu
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
job75
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
641
gwenn49
G
V
  • Question
XL pour MAC outil coller le contenu du presse papier
Réponses
2
Affichages
553
Valter
V

Membres actuellement en ligne

10 membres et 254 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 131
Messages
2 116 572
Membres
112 792
dernier inscrit
Jean-Marc YOT