Microsoft 365 Simplifier une macro enregistrée

Patoche42 · 3 Janvier 2023

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.

sylvanu · 3 Janvier 2023

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

Lolote83 · 3 Janvier 2023

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

sylvanu · 3 Janvier 2023

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.

Patoche42 · 4 Janvier 2023

Merci Lolote et sylvanu d'avoir pris du temps pour moi.
C'est ce que je recherchais nickel.
Je vais essayer ça.
Merci encore

Microsoft 365 Simplifier une macro enregistrée

Patoche42

XLDnaute Junior

Pièces jointes

sylvanu

Lolote83

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Patoche42

XLDnaute Junior

Discussions similaires

Microsoft 365 Simplifier une macro enregistrée

Patoche42

XLDnaute Junior

Pièces jointes

Lolote83

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Patoche42

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency