Bonjour à tous,

J'ai une erreur "procédure trop longue".
Je soupçonne que c'est parce que mon code est beaucoup trop long.

Voici le début du code:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
 
If MaFsource.Cells(77, Col).Value = "" Then
            ShDEST.Range("B2").Value = IIf(Len(MaFsource.Cells(79, Col).Value) = 0, "", (MaFsource.Cells(79, Col).Value))
            ShDEST.Range("B2").Value = ShDEST.Range("B2").Value & IIf(Len(MaFsource.Cells(80, Col).Value) = 0, "", vbLf & MaFsource.Cells(80, Col).Value)
            ShDEST.Range("B2").Value = ShDEST.Range("B2").Value & IIf(Len(MaFsource.Cells(81, Col).Value) = 0, "", vbLf & MaFsource.Cells(81, Col).Value)
            If MaFsource.Cells(79, Col).Value = "" And MaFsource.Cells(80, Col).Value = "" And MaFsource.Cells(81, Col).Value = "" Then ShDEST.Range("B2").Value = "Aucune activité inscrite"
        End If
        If MaFsource.Cells(77, Col).Value <> "" Then
        ShDEST.Range("B2").Value = MaFsource.Cells(77, Col).Value
        End If
 
         If MaFsource.Cells(82, Col).Value = "" Then
            ShDEST.Range("D2").Value = IIf(Len(MaFsource.Cells(84, Col).Value) = 0, "", (MaFsource.Cells(84, Col).Value))
            ShDEST.Range("D2").Value = ShDEST.Range("D2").Value & IIf(Len(MaFsource.Cells(85, Col).Value) = 0, "", vbLf & MaFsource.Cells(85, Col).Value)
            ShDEST.Range("D2").Value = ShDEST.Range("D2").Value & IIf(Len(MaFsource.Cells(86, Col).Value) = 0, "", vbLf & MaFsource.Cells(86, Col).Value)
            If MaFsource.Cells(79, Col).Value = "" And MaFsource.Cells(80, Col).Value = "" And MaFsource.Cells(81, Col).Value = "" Then ShDEST.Range("D2").Value = "Aucune activité inscrite"
       End If
       If MaFsource.Cells(82, Col).Value <> "" Then
        ShDEST.Range("D3").Value = MaFsource.Cells(92, Col).Value
        End If
 
       If MaFsource.Cells(87, Col).Value = "" Then
            ShDEST.Range("B3").Value = IIf(Len(MaFsource.Cells(89, Col).Value) = 0, "", (MaFsource.Cells(89, Col).Value))
            ShDEST.Range("B3").Value = ShDEST.Range("B3").Value & IIf(Len(MaFsource.Cells(90, Col).Value) = 0, "", vbLf & MaFsource.Cells(90, Col).Value)
            ShDEST.Range("B3").Value = ShDEST.Range("B3").Value & IIf(Len(MaFsource.Cells(91, Col).Value) = 0, "", vbLf & MaFsource.Cells(91, Col).Value)
            If MaFsource.Cells(89, Col).Value = "" And MaFsource.Cells(90, Col).Value = "" And MaFsource.Cells(91, Col).Value = "" Then ShDEST.Range("B3").Value = "Aucune activité inscrite"
        End If
        If MaFsource.Cells(87, Col).Value <> "" Then
        ShDEST.Range("B3").Value = MaFsource.Cells(87, Col).Value
        End If
 
         If MaFsource.Cells(92, Col).Value = "" Then
            ShDEST.Range("D3").Value = IIf(Len(MaFsource.Cells(94, Col).Value) = 0, "", (MaFsource.Cells(94, Col).Value))
            ShDEST.Range("D3").Value = ShDEST.Range("D3").Value & IIf(Len(MaFsource.Cells(95, Col).Value) = 0, "", vbLf & MaFsource.Cells(95, Col).Value)
            ShDEST.Range("D3").Value = ShDEST.Range("D3").Value & IIf(Len(MaFsource.Cells(96, Col).Value) = 0, "", vbLf & MaFsource.Cells(96, Col).Value)
            If MaFsource.Cells(94, Col).Value = "" And MaFsource.Cells(95, Col).Value = "" And MaFsource.Cells(96, Col).Value = "" Then ShDEST.Range("D3").Value = "Aucune activité inscrite"
       End If
       If MaFsource.Cells(92, Col).Value <> "" Then
        ShDEST.Range("D3").Value = MaFsource.Cells(92, Col).Value
        End If
Voici la fin du code
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
If MaFsource.Cells(357, Col).Value = "" Then
            ShDEST.Range("B30").Value = IIf(Len(MaFsource.Cells(359, Col).Value) = 0, "", (MaFsource.Cells(359, Col).Value))
            ShDEST.Range("B30").Value = ShDEST.Range("B30").Value & IIf(Len(MaFsource.Cells(360, Col).Value) = 0, "", vbLf & MaFsource.Cells(360, Col).Value)
            ShDEST.Range("B30").Value = ShDEST.Range("B30").Value & IIf(Len(MaFsource.Cells(361, Col).Value) = 0, "", vbLf & MaFsource.Cells(361, Col).Value)
            If MaFsource.Cells(359, Col).Value = "" And MaFsource.Cells(360, Col).Value = "" And MaFsource.Cells(361, Col).Value = "" Then ShDEST.Range("B30").Value = "Aucune activité inscrite"
        End If
        If MaFsource.Cells(357, Col).Value <> "" Then
        ShDEST.Range("B30").Value = MaFsource.Cells(357, Col).Value
        End If
 
        If MaFsource.Cells(362, Col).Value = "" Then
            ShDEST.Range("D30").Value = IIf(Len(MaFsource.Cells(364, Col).Value) = 0, "", (MaFsource.Cells(364, Col).Value))
            ShDEST.Range("D30").Value = ShDEST.Range("D30").Value & IIf(Len(MaFsource.Cells(365, Col).Value) = 0, "", vbLf & MaFsource.Cells(365, Col).Value)
            ShDEST.Range("D30").Value = ShDEST.Range("D30").Value & IIf(Len(MaFsource.Cells(366, Col).Value) = 0, "", vbLf & MaFsource.Cells(366, Col).Value)
            If MaFsource.Cells(364, Col).Value = "" And MaFsource.Cells(365, Col).Value = "" And MaFsource.Cells(366, Col).Value = "" Then ShDEST.Range("D30").Value = "Aucune activité inscrite"
       End If
       If MaFsource.Cells(357, Col).Value <> "" Then
        ShDEST.Range("D30").Value = MaFsource.Cells(357, Col).Value
        End If
Quelques explications :
j'ai des blocs de données qui se présentent toujours de la même façon :
On commence à la ligne 77
Le premier bloc va de la ligne 77 à la ligne 81
Le second bloc va de la ligne 82 à la ligne 86
Le troisième bloc va de la ligne 87 à la ligne 91
Le quatrième bloc va de la ligne 92 à la ligne 96
et ainsi de suite...
Les blocs de données commencent toujours en alternance par un numéro de ligne paire ou impaire et ils sont constitués de 5 lignes dans lesquelles je prélèves les données pour les placer sur une autre feuille.

Je suppose que l'on peut faire beaucoup mieux que ce que j'ai écrit... mais je ne suis vraiment pas un spécialiste des macros alors votre aide sera plus que bienvenue.