XL 2013 améliorons cette boucle et la déclarations des variables :)

[Luc St-laurent]

Bonjour à tous,

Le code ci-dessous roule bien mais il n'est vraiment pas élégant et il est loin d'être optimal.
Est-ce que vous auriez des idées pour améliorer l'exécution et la rapidité de celui-ci.

merci

Option Explicit

Sub Boucle()

Dim r As Long, m As Integer, mm As Variant, n As Integer, mmArray As Variant, nr As Integer, mct As Integer, i As Integer

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False


    m = Range("B8")
    r = 26 + m
    nr = 1



    mmArray = Array(1, 4, 8, 15, 22, 26, 27, 32, 44, 77)

        For Each mm In mmArray
            mct = 1


    ThisWorkbook.Activate
        Sheet1.Select
        Range("B1").Select
            ActiveCell.FormulaR1C1 = "='[chiffres.xlsx]MM@" & mm & "'!R" & r & "C6"
        
        Range("B2").Select
            ActiveCell.FormulaR1C1 = "='[chiffres.xlsx]MM@" & mm & "'!R" & r & "C10"
        
'Clear
    
        ActiveSheet.Range("R2:R" & Range("R2").End(xlDown).Row).ClearContents
    
'Copier et transposer l'historique.
    
            Windows("chiffres.xlsx").Activate
                Sheets("MM@" & mm & "").Select
                    Range("A1").Select
                ActiveCell.Offset(25 + m, 13 + mm).Range("A1").Select
            Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    
    ThisWorkbook.Activate 'Transposer
        Range("R2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("R1").Select
    
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

    
'**********
Macro2
'**********

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

        
' Copier Coller

                For i = 1 To 4

                        Sheet1.Select ' Copier
                                Range("A1").Select
                                ActiveCell.Offset(9 + i, 1).Range("A1:J1").Select
                                Selection.Copy
    
                        Sheet13.Select ' Coller
                                Range("A1").Select
                                ActiveCell.Offset(7 + nr, 2 + mct).Range("A1").Select
                
                        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
                            SkipBlanks:=False, Transpose:=False
            
                    mct = mct + 16 ' Offset de 16 vers la droite pour le prochain
    
                Next i
                
         nr = nr + 1
        
 Next mm
 
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Sub

 

[soan]

@Luc St-laurent

Je te laisse lire mes 2 posts précédents, puis celui-ci.

Pour : nbr = Range("S2") - 1: Range("S2") =COUNT(R2:R10000)

mets à la place :

nbr = [S2] - 1: [S2] = WorksheetFunction.CountA([R2:R10000])

--------------------------------------------------------------------------

Et si tu veux le faire pour toute la colonne R :

nbr = [S2] - 1: [S2] = WorksheetFunction.CountA(Columns(18))

soan