Signaler

Rechercheoptimisation macro excel

Posez votre question alex141077 25Messages postés vendredi 5 avril 2013Date d'inscription 21 octobre 2017 Dernière intervention - Dernière réponse le 21 oct. 2017 à 19:27 par alex141077
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


Utile
+0
plus moins
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 .....
Donnez votre avis
Utile
+0
plus moins
je voudrais bien mais je ne trouve pas comment insérer les fichiers
alex141077 25Messages postés vendredi 5 avril 2013Date d'inscription 21 octobre 2017 Dernière intervention - 13 oct. 2017 à 20:39
Les fichiers se trouvent dans ce lien

http://www.cjoint.com/c/GJnsNjUrlEO
Répondre
alex141077 25Messages postés vendredi 5 avril 2013Date d'inscription 21 octobre 2017 Dernière intervention - 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.
Répondre
Donnez votre avis
Utile
+0
plus moins
Và sur http://www.cjoint.com
Donnez votre avis
Utile
+0
plus moins
http://www.cjoint.com/c/GJnsNjUrlEO
Donnez votre avis
Utile
+0
plus moins
Je relance le sujet pour votre aide SVP
gbinforme 14218Messages postés lundi 18 octobre 2004Date d'inscription ContributeurStatut 21 octobre 2017 Dernière intervention - 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.
Répondre
alex141077 25Messages postés vendredi 5 avril 2013Date d'inscription 21 octobre 2017 Dernière intervention - 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
Répondre
Donnez votre avis
Utile
+0
plus moins
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 : http://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.
Donnez votre avis
Utile
+0
plus moins
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é
http://www.cjoint.com/c/GJvnHVQe5YO
gbinforme 14218Messages postés lundi 18 octobre 2004Date d'inscription ContributeurStatut 21 octobre 2017 Dernière intervention - 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.
Répondre
alex141077 25Messages postés vendredi 5 avril 2013Date d'inscription 21 octobre 2017 Dernière intervention - 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
Répondre
Donnez votre avis

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !