Aide pour réduction de code

**dreamsodfa** · 08/11/2019, 14h18

Bonjour forum

est ce que possible de réduire se code :
Merci

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
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
 
Private Sub CommandButton2_Click()
 Dim sh
    Application.ScreenUpdating = 0
    For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
 
        Sheets("ASSURANCE").Range("B3:C32").Copy Sheets(sh).Range("B3")
        Sheets("ASSURANCE").Range("B36:C65").Copy Sheets(sh).Range("B36")
        Sheets("ASSURANCE").Range("B69:C98").Copy Sheets(sh).Range("B69")
        Sheets("ASSURANCE").Range("B102:C131").Copy Sheets(sh).Range("B102")
        Sheets("ASSURANCE").Range("B135:C164").Copy Sheets(sh).Range("B135")
        Sheets("ASSURANCE").Range("B168:C197").Copy Sheets(sh).Range("B168")
        Sheets("ASSURANCE").Range("B201:C230").Copy Sheets(sh).Range("B201")
        Sheets("ASSURANCE").Range("B234:C263").Copy Sheets(sh).Range("B234")
        Sheets("ASSURANCE").Range("B267:C296").Copy Sheets(sh).Range("B267")
        Sheets("ASSURANCE").Range("B300:C329").Copy Sheets(sh).Range("B300")
 
        Sheets("ASSURANCE").Range("B333:C362").Copy Sheets(sh).Range("B333")
        Sheets("ASSURANCE").Range("B366:C395").Copy Sheets(sh).Range("B366")
        Sheets("ASSURANCE").Range("B399:C428").Copy Sheets(sh).Range("B399")
        Sheets("ASSURANCE").Range("B432:C461").Copy Sheets(sh).Range("B432")
        Sheets("ASSURANCE").Range("B465:C494").Copy Sheets(sh).Range("B465")
        Sheets("ASSURANCE").Range("B498:C527").Copy Sheets(sh).Range("B498")
        Sheets("ASSURANCE").Range("B531:C560").Copy Sheets(sh).Range("B531")
        Sheets("ASSURANCE").Range("B564:C593").Copy Sheets(sh).Range("B564")
        Sheets("ASSURANCE").Range("B597:C626").Copy Sheets(sh).Range("B597")
        Sheets("ASSURANCE").Range("B630:C659").Copy Sheets(sh).Range("B630")
 
        Sheets("ASSURANCE").Range("B663:C692").Copy Sheets(sh).Range("B663")
        Sheets("ASSURANCE").Range("B696:C725").Copy Sheets(sh).Range("B696")
        Sheets("ASSURANCE").Range("B729:C758").Copy Sheets(sh).Range("B729")
        Sheets("ASSURANCE").Range("B762:C791").Copy Sheets(sh).Range("B762")
        Sheets("ASSURANCE").Range("B795:C824").Copy Sheets(sh).Range("B795")
        Sheets("ASSURANCE").Range("B828:C857").Copy Sheets(sh).Range("B828")
        Sheets("ASSURANCE").Range("B861:C890").Copy Sheets(sh).Range("B861")
        Sheets("ASSURANCE").Range("B894:C923").Copy Sheets(sh).Range("B894")
        Sheets("ASSURANCE").Range("B927:C956").Copy Sheets(sh).Range("B927")
        Sheets("ASSURANCE").Range("B960:C989").Copy Sheets(sh).Range("B960")
 
        Sheets("ASSURANCE").Range("B993:C1022").Copy Sheets(sh).Range("B993")
        Sheets("ASSURANCE").Range("B1026:C1055").Copy Sheets(sh).Range("B1026")
        Sheets("ASSURANCE").Range("B1059:C1088").Copy Sheets(sh).Range("B1059")
        Sheets("ASSURANCE").Range("B1092:C1121").Copy Sheets(sh).Range("B1092")
        Sheets("ASSURANCE").Range("B1125:C1154").Copy Sheets(sh).Range("B1125")
        Sheets("ASSURANCE").Range("B1158:C1187").Copy Sheets(sh).Range("B1158")
        Sheets("ASSURANCE").Range("B1191:C1220").Copy Sheets(sh).Range("B1191")
        Sheets("ASSURANCE").Range("B1224:C1253").Copy Sheets(sh).Range("B1224")
        Sheets("ASSURANCE").Range("B1257:C1286").Copy Sheets(sh).Range("B1257")
        Sheets("ASSURANCE").Range("B1290:C1319").Copy Sheets(sh).Range("B1290")
 
 
        Sheets("ASSURANCE").Range("B1323:C1352").Copy Sheets(sh).Range("B1323")
        Sheets("ASSURANCE").Range("B1356:C1385").Copy Sheets(sh).Range("B1356")
        Sheets("ASSURANCE").Range("B1389:C1418").Copy Sheets(sh).Range("B1389")
        Sheets("ASSURANCE").Range("B1422:C1451").Copy Sheets(sh).Range("B1422")
        Sheets("ASSURANCE").Range("B1455:C1484").Copy Sheets(sh).Range("B1455")
        Sheets("ASSURANCE").Range("B1488:C1517").Copy Sheets(sh).Range("B1488")
        Sheets("ASSURANCE").Range("B1521:C1550").Copy Sheets(sh).Range("B1521")
        Sheets("ASSURANCE").Range("B1554:C1583").Copy Sheets(sh).Range("B1554")
        Sheets("ASSURANCE").Range("B1587:C1616").Copy Sheets(sh).Range("B1587")
        Sheets("ASSURANCE").Range("B1620:C1649").Copy Sheets(sh).Range("B1620")
 
    Next sh
    MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"     
        ActiveWorkbook.Save
End Sub

**Menhir** · 08/11/2019, 14h50

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub CommandButton2_Click()
 Dim sh As String, i As Long
    Application.ScreenUpdating = 0
    For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
        For i = 3 To 1620 Step 33
            Sheets("ASSURANCE").Range("B" & i & ":C" & (i + 29)).Copy Sheets(sh).Range("B" & i)
        Next i
    Next sh
    MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"     
    ActiveWorkbook.Save
End Sub

Avoir utilisé des numéros pour tes noms d'onglets (01, 02, 03, etc.) t'aurait évité ce long Array et sans doute facilité les traitements futurs.

**dreamsodfa** · 08/11/2019, 17h16

Envoyé par Menhir

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub CommandButton2_Click()
 Dim sh As String, i As Long
    Application.ScreenUpdating = 0
    For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
End Sub