Microsoft 365 Simplifier une macro enregistrée

P

Patoche42

XLDnaute Junior
Bonjour à vous ,
Je sollicite encore vos talents .
J'ai créé une macro à l'aide "l'enregistreur de macro" et qui fonctionne très bien, mais qui est trèèèès loooongue.
Je sais que c'est possible de la raccourcir, j'ai essayé de mon côté, en vain.
Si vous pouviez regarder ça, en vous vous remerciant par avance.
 

Pièces jointes

  • Rapport interne → Rapport Allemand - Copie.xlsm
    920.7 KB · Affichages: 12
Solution
sylvanu
Bonjour Viviepat, Lolotte,
Une autre approche:
1- Commencez votre macro par :
VB: 
 Application.ScreenUpdating = False
Comme l'a fait Lolotte, ça fige l'écran et accélère beaucoup.
2- On peut remplacer :
Code: 
For i = 2 To 21
    .Cells(i + 15, 1) = Sheets("Rapport Interne").Cells(10, i)
Next i
par
Code: 
Sheets("Rapport Allemand").Range("A17:A36") = Application.Transpose(Sheets("Rapport Interne").Range("B10:U10"))
3- On peut remplacer :
Code: 
Range("A29:A38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Rapport Allemand").Select
Range("I16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
    Sheets("Rapport Interne").Select
par...
Trier par date Trier par votes
L

Lolote83

XLDnaute Barbatruc
Bonjour,
Vite fait unne autre façon.
Tout n'est pas fait, tu peux t'inspirer du début. Il y a certainement plus rapide, mais je n'ai pas le temps actuellement

A toi de finir le boulot

VB: 
Sub Macro2()
    Application.ScreenUpdating = False
    With Sheets("Rapport Allemand")
    
    ' Copie des Positions
        
        For i = 2 To 21
            .Cells(i + 15, 1) = Sheets("Rapport Interne").Cells(10, i) ' Copie des Positions
            .Cells(i + 15, 4) = Sheets("Rapport Interne").Cells(13, i) ' Copie des  Tol. Nom.
            .Cells(i + 15, 5) = Sheets("Rapport Interne").Cells(15, i) ' Copie des  Tol. Mini.
            .Cells(i + 15, 6) = Sheets("Rapport Interne").Cells(14, i) ' Copie des  Tol. Max
        Next i
        
        For i = 23 To 42
            .Cells(i + 14, 1) = Sheets("Rapport Interne").Cells(10, i) ' Copie des Positions
            .Cells(i + 14, 4) = Sheets("Rapport Interne").Cells(13, i) ' Copie des  Tol. Nom.
            .Cells(i + 14, 5) = Sheets("Rapport Interne").Cells(15, i) ' Copie des  Tol. Mini.
            .Cells(i + 14, 6) = Sheets("Rapport Interne").Cells(14, i) ' Copie des  Tol. Max
        Next i
        For i = 44 To 63
            .Cells(i + 13, 1) = Sheets("Rapport Interne").Cells(10, i) ' Copie des Positions
            .Cells(i + 13, 4) = Sheets("Rapport Interne").Cells(13, i) ' Copie des  Tol. Nom.
            .Cells(i + 13, 5) = Sheets("Rapport Interne").Cells(15, i) ' Copie des  Tol. Mini.
            .Cells(i + 13, 6) = Sheets("Rapport Interne").Cells(14, i) ' Copie des  Tol. Max
        Next i
        For i = 65 To 84
            .Cells(i + 12, 1) = Sheets("Rapport Interne").Cells(10, i) ' Copie des Positions
            .Cells(i + 12, 4) = Sheets("Rapport Interne").Cells(13, i) ' Copie des  Tol. Nom.
            .Cells(i + 12, 5) = Sheets("Rapport Interne").Cells(15, i) ' Copie des  Tol. Mini.
            .Cells(i + 12, 6) = Sheets("Rapport Interne").Cells(14, i) ' Copie des  Tol. Max
        Next i
        For i = 86 To 105
            .Cells(i + 11, 1) = Sheets("Rapport Interne").Cells(10, i) ' Copie des Positions
            .Cells(i + 11, 4) = Sheets("Rapport Interne").Cells(13, i) ' Copie des  Tol. Nom.
            .Cells(i + 11, 5) = Sheets("Rapport Interne").Cells(15, i) ' Copie des  Tol. Mini.
            .Cells(i + 11, 6) = Sheets("Rapport Interne").Cells(14, i) ' Copie des  Tol. Max
        Next i
   End With
    
' Copie des N° d'empreintes
    With Sheets("Rapport interne")
        .Range("A29:A38").Copy
        Sheets("Rapport Allemand").Range("I16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            
        .Range("A39:A48").Copy
        Sheets("Rapport Allemand").Range("AD16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
          
       .Range("A49:A58").Copy
        Sheets("Rapport Allemand").Range("AY16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      
       .Range("A59:A68").Copy
        Sheets("Rapport Allemand").Range("BT16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
          
        .Range("A69:A78").Copy
        Sheets("Rapport Allemand").Range("CO16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        
        .Range("A79:A88").Copy
        Sheets("Rapport Allemand").Range("DJ16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

        .Range("A89:A98").Copy
        Sheets("Rapport Allemand").Range("EE16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

        .Range("A99:A108").Copy
        Sheets("Rapport Allemand").Range("EZ16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
 
        .Range("A109:A118").Copy
        Sheets("Rapport Allemand").Range("FU16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

        .Range("A119:A128").Copy
        Sheets("Rapport Allemand").Range("GP16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

        .Range("A129:A138").Copy
        Sheets("Rapport Allemand").Range("HK16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    End With
          
          
          
          
       Range("A139:A148").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("IF16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A149:A158").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("JA16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A159:A168").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("JV16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A169:A178").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("KQ16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A179:A188").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("LL16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A189:A198").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("MG16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A199:A208").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("NB16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A209:A218").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("NW16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A219:A228").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("OR16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A229:A238").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("PM16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A239:A248").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("QH16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A249:A258").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("RC16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A259:A268").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("RX16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A269:A278").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("SS16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A289:A298").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("TN16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A299:A308").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("UI16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A309:A318").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("VD16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A319:A328").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("VY16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A329:A338").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("WT16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A339:A348").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("XO16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A349:A358").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("YJ16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A359:A368").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("ZE16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A369:A378").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("ZZ16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
       Range("A379:A388").Select
           Application.CutCopyMode = False
           Selection.Copy
           Sheets("Rapport Allemand").Select
       Range("AAU16").Select
           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=True
           Sheets("Rapport Interne").Select
          
    Application.ScreenUpdating = True
End Sub
@+ Lolote83
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Viviepat, Lolotte,
Une autre approche:
1- Commencez votre macro par :
VB: 
 Application.ScreenUpdating = False
Comme l'a fait Lolotte, ça fige l'écran et accélère beaucoup.
2- On peut remplacer :
Code: 
For i = 2 To 21
    .Cells(i + 15, 1) = Sheets("Rapport Interne").Cells(10, i)
Next i
par
Code: 
Sheets("Rapport Allemand").Range("A17:A36") = Application.Transpose(Sheets("Rapport Interne").Range("B10:U10"))
3- On peut remplacer :
Code: 
Range("A29:A38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Rapport Allemand").Select
Range("I16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
    Sheets("Rapport Interne").Select
par
Code: 
Sheets("Rapport Allemand").Range("I16:R16") = Application.Transpose(Sheets("Rapport Interne").Range("A29:A38"))
Ce qui devrait accélérer de beaucoup la macro.

Désolé, je n'ai pas eu le courage de le faire pour toute la macro.
 
Vote positif 0 Vote négatif
Solution

Discussions similaires

B
  • Question
XL 2019 simplifier une formule si imbriquée
2
Réponses
18
Affichages
644
Bnj
B
L
  • Résolu(e)
XL 2021 Enregistrer des données dans un tableau vide via une macro
Réponses
14
Affichages
473
LeLigérien
L
dindin
  • Question
XL 2016 simplifier une macro enregistrée
Réponses
8
Affichages
541
dindin
dindin
A
  • Question
XL 2019 Filtre avancé + Colonnes spécifiques (VBA)
Réponses
9
Affichages
336
Amilo
A
chilo27
  • Question
Autres Simplifier une action
Réponses
5
Affichages
187
chilo27
chilo27
L
  • Résolu(e)
XL 2019 Important : Nommer fichier grâce aux éléments de publipostage
Réponses
6
Affichages
271
LeForain
L
G
  • Question
XL 2016 Répartition mensuelle de la charge par équipe en fonction d'une date de début et d'une date de fin
Réponses
4
Affichages
358
Lolote83
L
P
  • Résolu(e)
Microsoft 365 Insérer des lignes prédéfini à la suite
Réponses
2
Affichages
279
Patoche42
P
P
  • Question
XL 2021 macro interruption erreur
Réponses
7
Affichages
222
Dranreb
Dranreb
R
  • Résolu(e)
XL 2019 amélioration d'une macro (actualisation auto et automatisation)
Réponses
11
Affichages
310
rh.finances
R

Membres actuellement en ligne

14 membres et 101 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
312 223
Messages
2 086 407
Membres
103 201
dernier inscrit
centrale vet