Microsoft 365 Optimisation code VBA - Succession de copier coller

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 :)
 

cp4

XLDnaute Accro
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.
 

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:

cp4

XLDnaute Accro
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
 

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

*Merci de ton retour @flomag

@Phil69970
 

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
 

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

Statistiques des forums

Discussions
300 907
Messages
1 988 377
Membres
210 125
dernier inscrit
manager2015