Sujet Précédent Sujet Suivant

Rechercheoptimisation macro excel

Fermé
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 - Modifié le 13 oct. 2017 à 19:11
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 - 23 oct. 2017 à 21:23
Bonjour,


Avant tout je remercie toutes les personnes qui m'aideront à améliorer ma macro.
Je viens recherche de l'aide auprès de vous car j'ai concu cette macro qui me sert dans mon travail.

Dans un premier temps je souhaiterais l'optimiser car la procédure est excessivement longue.

Cette macro copie plusieurs informations a partir d'une valeur qu'elle trouve sur une feuille puis elle colle ces informations sur une autre feuille et place informations les unes sous les autres.

Je vous place la macro ci dessous. Merci de votre aide 

Sub Comptage_Grande_barquette()
On Error Resume Next

'Application.ScreenUpdating = False
'Application.DisplayAlerts = False

'----------------------------------LUNDI------------------------------------
    ' -------------Comptage des étiquettes Normal---------------

    Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Grande Barquette"
    Range("AR7").Select
    ActiveCell.FormulaR1C1 = "Lundi"
    Range("AR8").Select
    ActiveCell.FormulaR1C1 = "Midi & Soir"
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeNormal").Select
    Rows("2:500").Delete 'ClearContents
    numtsft = 1
    Range("A1:X100").Select
    Selection.Interior.ColorIndex = xlNone
    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("aj" & numlgn).Value > 0 Then
            Valeur = Range("aj" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn
    
    ' -------------Comptage des étiquettes Régime---------------
    
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeRégime").Select
Rows("2:500").Delete 'ClearContents
    numtsft = 1
    Range("A1:X100").Select
    Selection.Interior.ColorIndex = xlNone
    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("ak" & numlgn).Value > 0 Then
            Valeur = Range("ak" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn

' -------------Comptage des étiquettes des barquettes Normal individuelle---------------

     Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
Rows("2:500").Delete 'ClearContents
    numtsft = 2
    Range("A2:X100").Select
    Selection.Interior.ColorIndex = xlNone
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("AM" & numlgn).Value > 0 Then
            Valeur = Range("AM" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn
    
' -------------Comptage des étiquettes des barquettes Régime individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
Rows("2:500").Delete 'ClearContents
    numtsft = 2
    Range("A2:X100").Select
    Selection.Interior.ColorIndex = xlNone
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("an" & numlgn).Value > 0 Then
            Valeur = Range("an" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn
    
'-----------------------------MARDI------------------------------------------------------
    ' -------------Comptage des étiquettes Normal---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Grande Barquette"
    Range("AR7").Select
    ActiveCell.FormulaR1C1 = "Mardi"
    Range("AR8").Select
    ActiveCell.FormulaR1C1 = "Midi & Soir"
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeNormal").Select
    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("aj" & numlgn).Value > 0 Then
            Valeur = Range("aj" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn
    
    ' -------------Comptage des étiquettes Régime---------------
    
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeRégime").Select

    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("ak" & numlgn).Value > 0 Then
            Valeur = Range("ak" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn

' -------------Comptage des étiquettes des barquettes Normal individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("AM" & numlgn).Value > 0 Then
            Valeur = Range("AM" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn
    
' -------------Comptage des étiquettes des barquettes Régime individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
    
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("an" & numlgn).Value > 0 Then
            Valeur = Range("an" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn

'-----------------------------MERCREDI---------------------------------------------------
     ' -------------Comptage des étiquettes Normal---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Grande Barquette"
    Range("AR7").Select
    ActiveCell.FormulaR1C1 = "Mercredi"
    Range("AR8").Select
    ActiveCell.FormulaR1C1 = "Midi & Soir"
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeNormal").Select
    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("aj" & numlgn).Value > 0 Then
            Valeur = Range("aj" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn
    
    ' -------------Comptage des étiquettes Régime---------------
    
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeRégime").Select

    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("ak" & numlgn).Value > 0 Then
            Valeur = Range("ak" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn

' -------------Comptage des étiquettes des barquettes Normal individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("AM" & numlgn).Value > 0 Then
            Valeur = Range("AM" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn
    
' -------------Comptage des étiquettes des barquettes Régime individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
    
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("an" & numlgn).Value > 0 Then
            Valeur = Range("an" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn

'-----------------------------JEUDI------------------------------------------------------
 ' -------------Comptage des étiquettes Normal---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Grande Barquette"
    Range("AR7").Select
    ActiveCell.FormulaR1C1 = "Jeudi"
    Range("AR8").Select
    ActiveCell.FormulaR1C1 = "Midi & Soir"
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeNormal").Select
    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("aj" & numlgn).Value > 0 Then
            Valeur = Range("aj" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn
    
    ' -------------Comptage des étiquettes Régime---------------
    
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeRégime").Select

    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("ak" & numlgn).Value > 0 Then
            Valeur = Range("ak" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn

' -------------Comptage des étiquettes des barquettes Normal individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("AM" & numlgn).Value > 0 Then
            Valeur = Range("AM" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn
    
' -------------Comptage des étiquettes des barquettes Régime individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
    
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("an" & numlgn).Value > 0 Then
            Valeur = Range("an" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn

'-----------------------------VENDREDI---------------------------------------------------
 ' -------------Comptage des étiquettes Normal---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Grande Barquette"
    Range("AR7").Select
    ActiveCell.FormulaR1C1 = "Vendredi"
    Range("AR8").Select
    ActiveCell.FormulaR1C1 = "Midi & Soir"
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeNormal").Select
    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("aj" & numlgn).Value > 0 Then
            Valeur = Range("aj" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn
    
    ' -------------Comptage des étiquettes Régime---------------
    
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeRégime").Select

    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("ak" & numlgn).Value > 0 Then
            Valeur = Range("ak" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn

' -------------Comptage des étiquettes des barquettes Normal individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("AM" & numlgn).Value > 0 Then
            Valeur = Range("AM" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn
    
' -------------Comptage des étiquettes des barquettes Régime individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
    
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("an" & numlgn).Value > 0 Then
            Valeur = Range("an" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn

'-----------------------------SAMEDI-----------------------------------------------------
 ' -------------Comptage des étiquettes Normal---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Grande Barquette"
    Range("AR7").Select
    ActiveCell.FormulaR1C1 = "Samedi"
    Range("AR8").Select
    ActiveCell.FormulaR1C1 = "Midi & Soir"
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeNormal").Select
    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("aj" & numlgn).Value > 0 Then
            Valeur = Range("aj" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn
    
    ' -------------Comptage des étiquettes Régime---------------
    
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeRégime").Select

    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("ak" & numlgn).Value > 0 Then
            Valeur = Range("ak" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn

' -------------Comptage des étiquettes des barquettes Normal individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("AM" & numlgn).Value > 0 Then
            Valeur = Range("AM" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn
    
' -------------Comptage des étiquettes des barquettes Régime individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
    
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("an" & numlgn).Value > 0 Then
            Valeur = Range("an" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn

'-----------------------------DIMANCHE-----------------------------------------------------
 ' -------------Comptage des étiquettes Normal---------------

  Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Grande Barquette"
    Range("AR7").Select
    ActiveCell.FormulaR1C1 = "Dimanche"
    Range("AR8").Select
    ActiveCell.FormulaR1C1 = "Midi & Soir"
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeNormal").Select
    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("aj" & numlgn).Value > 0 Then
            Valeur = Range("aj" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn
    
    ' -------------Comptage des étiquettes Régime---------------
    
    Windows("Gestion analytique.xls").Activate
    Sheets("GrandeRégime").Select

    Do
    numtsft = numtsft + 1
    Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("ak" & numlgn).Value > 0 Then
            Valeur = Range("ak" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
            Sheets("GrandeRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    
    Next numlgn

' -------------Comptage des étiquettes des barquettes Normal individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("AM" & numlgn).Value > 0 Then
            Valeur = Range("AM" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitNormal").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn
    
' -------------Comptage des étiquettes des barquettes Régime individuelle---------------

 Windows("Etiquette.xls").Activate
    Sheets("Fiches").Select
    Range("Ai1").Select
    ActiveCell.FormulaR1C1 = "Petite Barquette"
    Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
    
        Do
        numtsft = numtsft + 1
       Loop While Range("A" & numtsft).Value > 0
    For numlgn = 6 To 1500
        Windows("Etiquette.xls").Activate
        If Range("an" & numlgn).Value > 0 Then
            Valeur = Range("an" & numlgn).Value
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("A" & numtsft).Value = Valeur
            Windows("Etiquette.xls").Activate
            Range("A" & numlgn & ":AG" & numlgn).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Gestion analytique.xls").Activate
    Sheets("PetitRégime").Select
            Range("B" & numtsft).Select
            ActiveSheet.Paste
            numtsft = numtsft + 1
        End If
    Next numlgn
    
    Windows("Effectif semaine 1.xls").Activate
    Range("I10").Select
    Windows("Gestion analytique.xls").Activate
    Sheets("Global").Select
    ActiveWorkbook.Save
    'ActiveWorkbook.Close


Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


A voir également:

7 réponses

Réponse 1 / 7
M-12 Messages postés 1333 Date d'inscription lundi 22 septembre 2008 Statut Membre Dernière intervention 8 avril 2023 299
Modifié le 13 oct. 2017 à 20:27
Bonsoir,

Au lieu de mettre en lien une macro (dont je ne lirai aucune ligne)
il serait mieux de mettre en PJ un classeur EXCEL avec cette macro et des exemples sans données privées
Cela donnera surement des réponses .....
0
Réponse 2 / 7
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
13 oct. 2017 à 20:29
je voudrais bien mais je ne trouve pas comment insérer les fichiers
0
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
13 oct. 2017 à 20:39
Les fichiers se trouvent dans ce lien

https://www.cjoint.com/c/GJnsNjUrlEO
0
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
13 oct. 2017 à 20:45
La macro se trouve dans le fichier "gestion analytique" module 20

elle extrait des données dans le fichier "Etiquette" dans la feuil "Fiche".

En suite elles sont collées dans 4 feuilles (GrandeNormal, GrandeRégime, PetiteNormal et PetiteRégime)

L'execution se réalise sans probleme mais cela met enormément de temps puis il y a beaucoup d'espace entre les lignes quand la macro colle les données.
0
Réponse 3 / 7
M-12 Messages postés 1333 Date d'inscription lundi 22 septembre 2008 Statut Membre Dernière intervention 8 avril 2023 299
13 oct. 2017 à 20:35
Và sur https://www.cjoint.com/
0
Réponse 4 / 7
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
13 oct. 2017 à 20:46
https://www.cjoint.com/c/GJnsNjUrlEO
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
15 oct. 2017 à 19:33
Je relance le sujet pour votre aide SVP
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
19 oct. 2017 à 09:01
Bonjour,

J'ai bien regardé ton souci, cependant
- tes colonnes de "fiches" pour sélection sont vides
- tu modifies sans raison apparemment le classeur 'Etiquette'
- tu passes les 7 jours de la semaine et comme rien n'est modifié, ils doivent être toujours identiques ?

J'ai fait une version plus rapide mais compte tenu des remarques, je ne vois pas bien le but à atteindre : une version correcte du classeur 'Etiquette' serait bienvenue.
0
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
19 oct. 2017 à 17:22
Merci Gbinforme de ton retour...
Il est vrai que les feuilles fonctionnent avec de nombreuses liaisons établit sur d'autres feuilles donc tu n'a pas tous les éléments. Le dossier complet est volumineux.
Il faudrait saisir manuellement 3 ou 4 valeurs dans la feuille fiche pour exemple.
Le classeur étiquette est modifié mais les données sont cachés pour l'utilisateur. la modification porte sur le changement de jour de la semaine.

je te mets à disposition le classeur en entier :
www.grosfichiers.com/EQHI6yrf18P0Z

Je peux jeter un coup d'oeil sur ta version plus rapide pour que je puisse comprendre?
Merci beaucoup
0
Réponse 6 / 7
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
21 oct. 2017 à 11:45
Bonjour alex141077,

Je peux jeter un coup d'oeil sur ta version plus rapide pour que je puisse comprendre?

Effectivement, ton organisation est assez complexe et comme tu as 28 sélections différentes (4 feuilles par 7 jours) la mise à jour ne peux pas être instantanée du fait des calculs intermédiaires.
J'ai modularisé la macro en petits modules qui ne font que leur fonction et les mise à jour de feuilles se font en une seule copie.
Cela devrait réduire le temps de mise à jour : j'aimerais bien connaitre celle que tu as, merci d'avance.

Voici donc le module : https://www.cjoint.com/c/GJvjLnmJqZl
Tu peux l'importer directement (dans l'éditeur VBA Fichier / importer) dans ton classeur 'Gestion analytique.xls'
et lancer 'Comptages_semaine' avec Etiquette.xls ouvert bien sûr.
0
Réponse 7 / 7
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
21 oct. 2017 à 15:34
Merci Gbinforme,

La macro s'execute sans erreur. Cependant après execution je n'ai aucun résultat.
Les feuilles "GrandeNormal", "GrandeRégime", "PetitNormal" et "PetitRégime" reste vide!!

Bien évidemment j'ai tenté de comprendre ta macro mais cela dépasse largement mes connaissances. Je vais me concentrer un peu plus!!!

Je te joint ci dessous mon module que tu as demandé
https://www.cjoint.com/c/GJvnHVQe5YO
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
21 oct. 2017 à 19:06
Bonjour alex141077,

Les feuilles "GrandeNormal", "GrandeRégime", "PetitNormal" et "PetitRégime" reste vide!!
Cela vient du fait que tes colonnes AK à AN ne se mettent pas à jour sinon le résultat est bien transféré.
Je pense que cela vient de la feuille 'Détails', essaies de rajouter : 
    WB.Sheets("Détails").Calculate
' avant
    WE.Calculate

Je te joint ci dessous mon module que tu as demandé
Non je me suis mal expliqué, c'était le temps d'exécution de ta macro que j'aurais aimé connaitre au moins approximativement.
0
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2
21 oct. 2017 à 19:27
Le temps d’exécution de ma macro? Je dirais entre 2 et 3 min.
11 secondes pour la tienne...c'est tres performant!!!

Helas toujours pas de résultat sur ces 4 feuilles
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
23 oct. 2017 à 18:39
Bonsoir,

J'ai essayé de lancer dans ton environnement mais même ainsi, ton classeur ne se met pas à jour la feuille et de même avec ta macro : je vois pas comment cela fonctionne.
0
alex141077 Messages postés 52 Date d'inscription vendredi 5 avril 2013 Statut Membre Dernière intervention 8 février 2022 2 > gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020
23 oct. 2017 à 21:23
Bonsoir,

Pourtant cela fonction bien avec ma macro...
Pour que toute les liaisons soient à jour, il faut que les fichiers suivant soit ouvert :
- Effectifs semaine1
- Etiquette
- Ration

Puis en ouvrant le fichier "Gestion analytique", ma macro s'execute sans probleme
je n'arrive pas à comprendre ou la tienne ne fonctionne pas!!!
Enfin merci beaucoup quand meme de ton aide et du temps que tu y as consacré.
0

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses