Simplification de code

Version imprimable

Bonjour,

Je ne suis pas un expert en Macro, mais j'arrive au résultat que je veux et c'est actuellement le principale pour ma boîte.
Seulement, je suis un peu perfectionniste et je me tourne vers vous pour m'aider à simplifier un peu mon code.

Voici une partie de celui-ci et je suis certain qu'il existe une façon plus simple de le coder.

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Sheets(3).Select
If ActiveSheet.Name <> feuille _
Then
    Sheets("Modèle").Select
    Sheets("Modèle").Copy After:=Sheets(2)
    ActiveSheet.Name = feuille
    ligne = 4
    'Préparation de la feuille de synthèse
    Sheets("Synthèse").Select
    Range("D4").Select
    Range(Selection, Selection.End(xlDown)).Select
    j = Selection.Rows.Count + 4
    Range("D" & j).Select
    ActiveCell.Formula = "=" & feuille & "!B13"
    Range("E" & j).Select
    ActiveCell.Formula = "=" & feuille & "!C13"
    Range("F" & j).Select
    ActiveCell.Formula = "=" & feuille & "!E13"
    Range("G" & j).Select
    ActiveCell.Formula = "=" & feuille & "!F13"
    Range("H" & j).Select
    ActiveCell.Formula = "=" & feuille & "!G13"
    Range("I" & j).Select
    ActiveCell.Formula = "=" & feuille & "!H13"
    Range("J" & j).Select
    ActiveCell.Formula = "=" & feuille & "!I13"
    Range("K" & j).Select
    ActiveCell.Formula = "=" & feuille & "!J13"
    Range("L" & j).Select
    ActiveCell.Formula = "=" & feuille & "!K13"
    Range("M" & j).Select
    ActiveCell.Formula = "=" & feuille & "!L13"
    Range("N" & j).Select
    ActiveCell.Formula = "=" & feuille & "!M13"
    Range("O" & j).Select
    ActiveCell.Formula = "=" & feuille & "!N13"
    Range("P" & j).Select
    ActiveCell.Formula = "=" & feuille & "!O13"
    Range("Q" & j).Select
    ActiveCell.Formula = "=" & feuille & "!P13"
    Range("R" & j).Select
    ActiveCell.Formula = "=" & feuille & "!Q13"
    Range("S" & j).Select
    ActiveCell.Formula = "=" & feuille & "!R13"
    Range("T" & j).Select
    ActiveCell.Formula = "=" & feuille & "!S13"
    Range("U" & j).Select
    ActiveCell.Formula = "=" & feuille & "!T13"
    Range("V" & j).Select
    ActiveCell.Formula = "=" & feuille & "!U13"
    Range("W" & j).Select
    ActiveCell.Formula = "=" & feuille & "!V13"
    Range("X" & j).Select
    ActiveCell.Formula = "=" & feuille & "!X13"
    Range("Y" & j).Select
    ActiveCell.Formula = "=" & feuille & "!X13"
    Range("Z" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AB13"
    Range("AA" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AC13"
    Range("AB" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AE13"
    Range("AC" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AF13"
    Range("AD" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AG13"
    Range("AE" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AH13"
    Range("AF" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AI13"
    Range("AG" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AJ13"
    Range("AH" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AK13"
    Range("AI" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AL13"
    Range("AJ" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AM13"
    Range("AK" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AN13"
    Range("AL" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AO13"
    Range("AM" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AP13"
    Range("AN" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AQ13"
    Range("AO" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AR13"
    Range("AP" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AT13"
    Range("AQ" & j).Select
    ActiveCell.Formula = "=" & feuille & "!AU13"
    Range("A1").Select
    Sheets(feuille).Select

En fait, je recopie texto dans différentes cellules (la ligne ne change pas et ça va de la colonne C à AP) le contenu de différentes cellules de la même ligne d'une autre feuille (par contre, dans ce cas, les colonnes ne sont pas successives).

Est-ce que qqun peut m'aider à alléger tout ça ?

Merci d'avancE.

bonjour,

ben un pti truc dans le genre je pense

Code:

1
2
3
4
5
6
7
8
9
10
11
12
If ActiveSheet.Name <> feuille _
Then
    Sheets(1).Copy After:=Sheets(2)
    ActiveSheet.Name = feuille
    'Préparation de la feuille de synthèse
    Set Rng = Sheet(2).Range(Cells(4, 4), Cells(4, 4).End(xlDown))
    For I = 1 To Rng.Rows.Count
        Sheets(2).Cells(4, 4).Offset(0, I).Formula = "=" & feuille & "!" & Cells(13, 2).Offset(0, I)
    Next I
    Range("A1").Select
    Sheets(feuille).Select
End If

06/06/2008, 11h51
Zolex

Un grand merci pour ta réponse.

Avant de tester tout ça, est-ce que tu pourrais m'expliquer les différentes lignes que tu as mises ?

Merci d'avance.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
If ActiveSheet.Name <> feuille _
Then
    'on copie la feuille active
    Sheets(1).Copy After:=Sheets(2)
    'on lui assigne un nom
    ActiveSheet.Name = feuille
    'Préparation de la feuille de synthèse
    'alors ici je reprends ton concept il faut que tu adapte si jamais, c'est pas bon
    'je fait une référence à la deuxieme fuille.
    'et le range correspond à la cellule ligne 4, colonne 4 jusque cette même cellule dont on aurais effectué "CTRL+fleche bas"
    Set Rng = Sheet(2).Range(Cells(4, 4), Cells(4, 4).End(xlDown))
    'on crée une boucle allant de 0 jusque le nopmbre de ligne présent dans le range -1
    For I = 1 To Rng.Rows.Count-1
        'on aplique une formule sur les cellules de la feuille 2 agrémenté d'un offset
        Sheets(2).Cells(4, 4).Offset(0, I).Formula = "=" & feuille & "!" & Cells(13, 2).Offset(0, I)
    Next I
    Range("A1").Select
    Sheets(feuille).Select
End If

06/06/2008, 13h30
Zolex

OK, je comprends mieux maintenant.
Seulement, je vais devoir un peu l'adapter, car les cellules cibles ne sont pas successives et donc, je dois prendre une autre valeur que I.

Mais ta réponse était presque parfaite :king:, je pense avoir compris ce qu'il me reste à faire.
Je teste la solution et je la poste.
06/06/2008, 13h33
mayekeul

oui je sais, il me semblais bien, mais c'était surtout pour te montrer la manière.

tu pourrais par exemple tester I pour voir si il doit operer ou pas!

J'ai essayé comme ceci, mais j'ai une erreur et je ne vois pas bien où

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
    Sheets("Modèle").Select
    Sheets("Modèle").Copy After:=Sheets(2)
    ActiveSheet.Name = feuille
    ligne = 4
    'Préparation de la feuille de synthèse
    Sheets("Synthèse").Select
    Range("D4").Select
    Range(Selection, Selection.End(xlDown)).Select
    j = Selection.Rows.Count + 4
    Set Rng = Sheets("Synthèse").Range(Cells(4, 4), Cells(4, 4).End(xlDown))
    m = 0
    For I = 1 To 39
        Sheets("synthèse").Cells(j, 4).Offset(0, I).Formula = "=" & feuille & "!" & Cells(13, 2).Offset(0, m)
        m = m + 1
        If m = 10 Then
            m = 12
        End If
    Next I

06/06/2008, 13h44
mayekeul

un erreur sur quelle ligne?
quelle est l'intitulé de l'erreur?
06/06/2008, 13h51
Zolex

Euh, oui, désolé, tant qu'à poser une question autant le faire de manière précise :lol:

J'ai une erreur sur la ligne

Code:

Sheets("synthèse").Cells(j, 4).Offset(0, I).Formula = "=" & feuille & "!" & Cells(13, 2).Offset(0, m)

Et c'est une erreur d'exécution '1004' : Erreur définie par l'application ou par l'objet

essaye ça
Code:

1 2 Sheets("synthèse").Cells(j, 4).Offset(0, I).Formula = "=" & feuille & "!" & Cells(13, 2).Offset(0, m).address
tu lui renvoyais la valeur de la cellule et non son adresse

Merci pour ta réponse.
Ca fonctionne parfaitement maintenant.

Voici le code que j'ai appliqué

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
Sheets("Modèle").Select
    Sheets("Modèle").Copy After:=Sheets(2)
    ActiveSheet.Name = feuille
    ligne = 4
    'Préparation de la feuille de synthèse
    Sheets("Synthèse").Select
    Range("D4").Select
    Range(Selection, Selection.End(xlDown)).Select
    j = Selection.Rows.Count + 4
    m = 0
    Range("D" & j).Select
    ActiveCell.Formula = "=" & feuille & "!B13"
    Range("E" & j).Select
    ActiveCell.Formula = "=" & feuille & "!C13"
    For I = 0 To 37
        Sheets("synthèse").Cells(j, 6).Offset(0, I).Formula = "=" & feuille & "!" & Cells(13, 5).Offset(0, m).Address
        m = m + 1
        If m = 18 Then
            m = 19
            Else
                If m = 21 Then
                    m = 23
                    Else
                        If m = 25 Then
                            m = 26
                            Else
                                If m = 40 Then
                                    m = 41
                                End If
                        End If
                End If
        End If
    Next I

Libre à quiconque de me proposer une meilleure solution (par exemple, au niveau de tous ces "if").