Rechercheoptimisation macro excel

alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 octobre 2017 Dernière intervention - 13 oct. 2017 à 18:58 - Dernière réponse : alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 octobre 2017 Dernière intervention
- 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


Afficher la suite 

15 réponses

Répondre au sujet
M-12 93 Messages postés lundi 22 septembre 2008Date d'inscription 14 décembre 2017 Dernière intervention - Modifié par M-12 le 13/10/2017 à 20:27
0
Utile
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 .....
Commenter la réponse de M-12
alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 octobre 2017 Dernière intervention - 13 oct. 2017 à 20:29
0
Utile
2
je voudrais bien mais je ne trouve pas comment insérer les fichiers
alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 octobre 2017 Dernière intervention - 13 oct. 2017 à 20:39
Les fichiers se trouvent dans ce lien

http://www.cjoint.com/c/GJnsNjUrlEO
alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 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.
Commenter la réponse de alex141077
M-12 93 Messages postés lundi 22 septembre 2008Date d'inscription 14 décembre 2017 Dernière intervention - 13 oct. 2017 à 20:35
0
Utile
Và sur http://www.cjoint.com
Commenter la réponse de M-12
alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 octobre 2017 Dernière intervention - 13 oct. 2017 à 20:46
Commenter la réponse de alex141077
alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 octobre 2017 Dernière intervention - 15 oct. 2017 à 19:33
0
Utile
2
Je relance le sujet pour votre aide SVP
gbinforme 14425 Messages postés lundi 18 octobre 2004Date d'inscriptionContributeurStatut 15 décembre 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.
alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 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
Commenter la réponse de alex141077
gbinforme 14425 Messages postés lundi 18 octobre 2004Date d'inscriptionContributeurStatut 15 décembre 2017 Dernière intervention - 21 oct. 2017 à 11:45
0
Utile
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.
Commenter la réponse de gbinforme
alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 octobre 2017 Dernière intervention - 21 oct. 2017 à 15:34
0
Utile
4
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 14425 Messages postés lundi 18 octobre 2004Date d'inscriptionContributeurStatut 15 décembre 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.
alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 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
gbinforme 14425 Messages postés lundi 18 octobre 2004Date d'inscriptionContributeurStatut 15 décembre 2017 Dernière intervention - 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.
alex141077 26 Messages postés vendredi 5 avril 2013Date d'inscription 23 octobre 2017 Dernière intervention > gbinforme 14425 Messages postés lundi 18 octobre 2004Date d'inscriptionContributeurStatut 15 décembre 2017 Dernière intervention - 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é.
Commenter la réponse de alex141077