Problème VBA - Simplification

Version imprimable

02/08/2011, 20h20
_Arie_

1 pièce(s) jointe(s)

Problème VBA - Simplification

Bonjour chère communauté,

J'aurais besoin de votre expertise VBAiste pour m'aider dans une de mes macros. Avant la semaine dernière, je n'avais jamais fait de macros. Je commence à me familiariser, mais j'aimerais savoir si vous pourriez m'aider à allèger ma macro. Elle fonctionne, mais elle est très répétitive. J'ai 52 feuilles où les actions que je pose sont identiques, mais où les cellules de référence sont différentes.

Je ne sais pas si je suis claire, mais je vous mets le script de ma macro. Comme mes classeurs sont confidentiels, je ne peux vous les joindre.

En espèrant que quelqu'un puisse m'aider,

Bonne journée

Bonjour,

En utilisant les objets Worksheet, on boucle sur les onglets du classeur.
Comme apparemment, les lignes sautent de 10 en 10, on fait avancer les variables de lignes i1, i2 et i3 de 10 a chaque changement d'onglet

Code a tester

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub demandesàtraiter()
Dim sh As Worksheet
Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
 
Workbooks.Open Filename:= _
    "G:\Voy-Prestations\Statistiques courrier\Statistiques&Correspondances-2011.xls"
Windows("Hebdo-2011 - Courbes(TO+MO).xls").Activate
 
i1 = 2
i2 = -7
i3 = -1
 
For Each sh In ActiveWorkbook.Worksheets
 
    sh.Range("I7").Select
    ActiveCell.FormulaR1C1 = _
        "='[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i1 & "]C[-5]"
    Selection.AutoFill Destination:=Range("I7:N7"), Type:=xlFillDefault
    Range("I8").Select
    ActiveCell.FormulaR1C1 = _
        "='[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i1 & "]C[-5]"
    Selection.AutoFill Destination:=Range("I8:N8"), Type:=xlFillDefault
    Range("I13").Select
    ActiveCell.FormulaR1C1 = _
        "='[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i2 & "]C[-5]+'[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i3 & "]C[-5]"
    Selection.AutoFill Destination:=Range("I13:N13"), Type:=xlFillDefault
    Range("I14").Select
    ActiveCell.FormulaR1C1 = _
        "='[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i2 & "]C[-5]+'[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i3 & "]C[-5]"
    Selection.AutoFill Destination:=Range("I14:N14"), Type:=xlFillDefault
    Range("N7:N8,N13:N14").Select
    With Selection.Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
 
    i1 = i1 + 10
    i2 = i2 + 10
    i3 = i3 + 10
 
Next sh
 
Windows("Statistiques&Correspondances-2011.xls").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Hebdo-2011 - Courbes(TO+MO).xls").Activate
Sheets("Statistiques").Select
ActiveWorkbook.Save
 
End Sub

Pas testé

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub Demandes_A_Traiter()
Dim Chemin As String, Fichier As String
Dim Wbk As Workbook
Dim Sh As Worksheet
Dim i As Byte
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Chemin = "G:\Voy-Prestations\Statistiques courrier\"
Fichier = "Statistiques&Correspondances-2011.xls"
 
Set Wbk = Workbooks.Open(Filename:=Chemin & Fichier)
For i = 1 To 52
    Set Sh = ThisWorkbook.Worksheets(CStr(i))
    With Sh
        With .Range("I7:N8")
            .FormulaR1C1 = "='[" & Fichier & "]Rapport hebdo'!R[" & 10 * i - 8 & "]C[-5]"
            .Value = .Value
        End With
        With .Range("I13:N14")
            .FormulaR1C1 = "='[" & Fichier & "]Rapport hebdo'!R[" & 10 * i - 17 & "]C[-5]+'[" & Fichier & "]Rapport hebdo'!R[" & 10 * i - 11 & "]C[-5]"
            .Value = .Value
        End With
        .Range("N7:N8,N13:N14").Interior.ColorIndex = 36
    End With
    Set Sh = Nothing
Next i
 
Wbk.Close False
Set Wbk = Nothing
 
MsgBox "Triatement terminé..."
Application.Calculation = xlCalculationAutomatic
End Sub

PS: Je remplace les formules par les valeurs, si tu veux garder les formules
Au lieu de ceci

Code:

1
2
3
4
        With .Range("I7:N8")
            .FormulaR1C1 = "='[" & Fichier & "]Rapport hebdo'!R[" & 10 * i - 8 & "]C[-5]"
            .Value = .Value
        End With

Mets simplement cela

Code:

.Range("I7:N8").FormulaR1C1 = "='[" & Fichier & "]Rapport hebdo'!R[" & 10 * i - 8 & "]C[-5]"

03/08/2011, 14h06
_Arie_

Tout d'abord,

Merci pour les réponses ultra-rapide! J'ai testé celui de JFontaine et tout marche! Sauf pour un point, mais c'est moi qui ne l'a pas spécifié dans mon premier post. Mon fichier contient 52 feuilles où je pose ma macro mais il y a d'autres feuilles dont je ne dois pas appliquer ma macro. Les feuilles que je dois appliquer la macro sont appelés "1" à "52". Comment dois-je modifier ma macro pour qu'elle ne tient compte que de ces feuilles?

Merci encore,

Ariane

En testant si le nom est entre 1 et 52

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub demandesàtraiter()
Dim sh As Worksheet
Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
 
Workbooks.Open Filename:= _
    "G:\Voy-Prestations\Statistiques courrier\Statistiques&Correspondances-2011.xls"
Windows("Hebdo-2011 - Courbes(TO+MO).xls").Activate
 
i1 = 2
i2 = -7
i3 = -1
 
For Each sh In ActiveWorkbook.Worksheets
  select Case sh.name
   case 1 to 52
    sh.Range("I7").Select
    ActiveCell.FormulaR1C1 = _
        "='[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i1 & "]C[-5]"
    Selection.AutoFill Destination:=Range("I7:N7"), Type:=xlFillDefault
    Range("I8").Select
    ActiveCell.FormulaR1C1 = _
        "='[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i1 & "]C[-5]"
    Selection.AutoFill Destination:=Range("I8:N8"), Type:=xlFillDefault
    Range("I13").Select
    ActiveCell.FormulaR1C1 = _
        "='[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i2 & "]C[-5]+'[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i3 & "]C[-5]"
    Selection.AutoFill Destination:=Range("I13:N13"), Type:=xlFillDefault
    Range("I14").Select
    ActiveCell.FormulaR1C1 = _
        "='[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i2 & "]C[-5]+'[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & i3 & "]C[-5]"
    Selection.AutoFill Destination:=Range("I14:N14"), Type:=xlFillDefault
    Range("N7:N8,N13:N14").Select
    With Selection.Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
 
    i1 = i1 + 10
    i2 = i2 + 10
    i3 = i3 + 10
 
  end select
Next sh
 
Windows("Statistiques&Correspondances-2011.xls").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("Hebdo-2011 - Courbes(TO+MO).xls").Activate
Sheets("Statistiques").Select
ActiveWorkbook.Save
 
End Sub

Rebonjour,

J'ai apporté des changements comme vous m'avez proposé. Mais il y a quelque chose qui ne marche pas... mes références sont décalées. Ma feuille "1" prend les références de la feuille "2", ma feuille "2" prend les références de la feuille "3" et ainsi de suite...

Alors, ma question est pourquoi? Pourtant, lorsque ma macro prend ma feuille "1", alors mes formules dans mes références devraient prendre i=1 ?? Est-ce que quelqu'un peut m'éclairer là-dessus?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub demandes()
Dim i As Integer      '<---- déclaration de variable
 
Workbooks.Open Filename:= _
        "G:\Voy-Prestations\Statistiques courrier\Statistiques&Correspondances-2011.xls"
    Windows("Hebdo-2011 - Courbes(TO+MO).xls").Activate
 
With Application      '<---- 4 lignes pour accélérer le traitement
   .ScreenUpdating = False
   .Calculation = xlManual
End With
 
For i = 1 To 52    '<---- Début de la boucle
With Worksheets(i)
.Range("I7:N8").FormulaR1C1 = _
        "='[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & 10 * i - 8 & "]C[-5]"
.Range("I13:N14").FormulaR1C1 = _
        "='[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & 10 * i - 17 & "]C[-5]+'[Statistiques&Correspondances-2011.xls]Rapport hebdo'!R[" & 10 * i - 11 & "]C[-5]"
End With
Next      '<---- Fin de la boucle
 
With Application      '<---- Réactivation des paramètres du classeurs désactivés plus haut
   .Calculation = xlAutomatic
    .ScreenUpdating = True
End With
 
Windows("Statistiques&Correspondances-2011.xls").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Windows("Hebdo-2011 - Courbes(TO+MO).xls").Activate
    Sheets("Statistiques").Select
 
End Sub

Merci encore,

Code:

Worksheets(i)

C'est la feuille d'index i (c 'est à dire la ième feuille)

Code:

Worksheets(cstr(i))

représente la feuille dont le nom est i.

je n'ai pas compris pourquoi tu n'as pas testé le code proposé sans Les Windows(xxx), Activate, Range sans feuille mère....

Code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Demandes()
Dim Chemin As String, Fichier As String
Dim Wbk As Workbook
Dim i As Byte                                           '<---- déclaration de variable
 
With Application                                        '<---- 4 lignes pour accélérer le traitement
    .ScreenUpdating = False
    .Calculation = xlManual
End With
 
Chemin = "G:\Voy-Prestations\Statistiques courrier\"    '<-- Données chemin et nom du fichier
Fichier = "Statistiques&Correspondances-2011.xls"
 
If Dir(Chemin & Fichier) <> "" Then                     '<----- Si le fichier existe
    Set Wbk = Workbooks.Open(Filename:=Chemin & Fichier)
 
    For i = 1 To 52                                     '<---- Début de la boucle
        With ThisWorkbook.Worksheets(CStr(i))
            .Range("I7:N8").FormulaR1C1 = "='[" & Fichier & "]Rapport hebdo'!R[" & 10 * i - 8 & "]C[-5]"
            .Range("I13:N14").FormulaR1C1 = "='[" & Fichier & "]Rapport hebdo'!R[" & 10 * i - 17 & "]C[-5]+'[" & Fichier & "]Rapport hebdo'!R[" & 10 * i - 11 & "]C[-5]"
        End With
    Next i                                              '<---- Fin de la boucle
 
    Wbk.Close False
    Set Wbk = Nothing
End If
 
With Application                                 '<---- Réactivation des paramètres du classeurs désactivés plus haut
    .Calculation = xlAutomatic
    .ScreenUpdating = True
End With
End Sub