Discussion :

[booskap]

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
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
95
96
97
98
99
100
Sub Placer()
 
vehicule = Cells(1, 18)
ligne_début = InputBox("Placer : Ligne début ?")
ligne_fin = InputBox("Placer : Ligne fin ?")
 
' balaye toutes lignes du tableau "planning"
For Ligne = ligne_début To ligne_fin
    test = 0
    If Cells(Ligne, 3) <> vehicule Then GoTo saut3:
    type_piece = Cells(Ligne, 2)
    For col_source = 36 To 48
    For lig_source = 7 To 500
        'si pas de référence, alors saut2
 
        If Sheets(vehicule).Cells(lig_source, 1) = "" Then GoTo saut2:
        ' teste type_pièce et soit manquants,
        ' soit (sur J+3 : stock + encours camions + placé < stock mini)
        If type_piece = Sheets(vehicule).Cells(lig_source, 3) And _
          (Sheets(vehicule).Cells(lig_source, col_source) < 0 Or _
          (col_source >= 38 And _
            Sheets(vehicule).Cells(lig_source, 6) + _
           Sheets(vehicule).Cells(lig_source, 8) < _
           Sheets(vehicule).Cells(lig_source, 7))) _
          Then GoSub calandres_exotiques: _
             Cells(Ligne, 12) = Cells(Ligne, 9) * Sheets(vehicule).Cells(lig_source, 5): _
             Sheets(vehicule).Cells(lig_source, 8) = Sheets(vehicule).Cells(lig_source, 8) + _
                Int(Cells(Ligne, 12) * (1 - Sheets(vehicule).Cells(4, 2))): _
             Cells(Ligne, 5) = Sheets(vehicule).Cells(lig_source, 4): _
             Cells(Ligne, 4) = Sheets(vehicule).Cells(lig_source, 1): _
             Cells(Ligne, 10) = Sheets(vehicule).Cells(lig_source, 5): _
       Cells(Ligne, 4) = Sheets(vehicule).Cells(lig_source, 1): _
            test = 1: GoTo saut
saut2:
    Next lig_source
    Next col_source
saut:
 
 
If test = 1 And col_source = 36 _
    Then Cells(Ligne, 13) = "j" & date_urgence
If test = 1 And col_source = 37 _
    Then Cells(Ligne, 13) = "j" & date_urgence
If test = 1 And col_source = 38 _
    Then Cells(Ligne, 13) = "j" & date_urgence
 
saut3:
Next Ligne
 
End
 
calandres_exotiques: ' rajoute le deuxième tour si calandre exotique en 2 tours
ref = Sheets(vehicule).Cells(lig_source, 2)
test_2tours = 0
For lig_2tours = 16 To 25
    If Sheets(vehicule).Cells(lig_2tours, 52) = ref Then test_2tours = 0
Next
If test_2tours = 0 Then GoTo fin
 
fin:
Return
 
End Sub
Sub enlever()
 
   vehicule = Cells(1, 18)
    ligne_début = InputBox("Enlever : Ligne début ?")
    ligne_fin = InputBox("Enlever : Ligne fin ?")
 
' balaye toutes lignes du tableau "planning"
For Ligne = ligne_début To ligne_fin
    test = 0
    If Cells(Ligne, 3) <> vehicule Then
    Ligne = Ligne + 1
    End If
 
        If Cells(Ligne, 12) <> 0 Then GoSub enleve_ligne
 
 
 
 
 
enleve_ligne:
'============
 
 
Cells(Ligne, 2) = ""
Cells(Ligne, 3) = ""
Cells(Ligne, 4) = ""
Cells(Ligne, 5) = ""
Cells(Ligne, 6) = ""
Cells(Ligne, 7) = ""
Cells(Ligne, 8) = ""
Cells(Ligne, 9) = ""
Cells(Ligne, 10) = ""
Cells(Ligne, 12) = ""
 
Next
 
End Sub

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
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
Sub MAJ()
 
 
Range("F7:F450,h7:O450,R7:R450,T7:AH450,T5:AH5").Select: Selection.ClearContents: Range("A1").Select
'efface données précédentes=>besoin stock, reste à fab
 
fichierdest = ActiveWorkbook.Name
feuilledest = ActiveSheet.Name
 
chemin = Range("B1"): fichier = Range("B2"): feuille = Range("B3")
'chemin sur réseau
 
Workbooks.Open Filename:=chemin + "\" + fichier
Windows(fichierdest).Activate
 
 
' Calcul_stock_et_reste Macro
' Macro enregistrée le 06/06/2007 par sandrine.ruffet
 
'format nombre
 
For r = 2 To 600
'test ligne vide à mettre pour fin extraction
 
While Not Workbooks(fichier).Sheets(feuille).Range("B" & r & "").Value = ""
   If Not Workbooks(fichier).Sheets(feuille).Range("B" & r & "").Value = "" Then
      Workbooks(fichier).Sheets(feuille).Range("B" & r & "").Value = Workbooks(fichier).Sheets(feuille).Range("B" & r & "").Value * 1
 
   End If
   r = r + 1
   Wend
   Next
 
LigneMaxExtraction = r - 1
Windows(fichierdest).Activate
Sheets(feuilledest).Activate
 
 
'Workbooks(fichierdest).Sheets(feuilledest).Select
 
' Paramètres
LigneDebut = 7
' Mise à jour des données du rapport
' principe : pour chaque ligne du rapport à traiter
' on recherche la ligne de la Ref Po dans la feille extraction
' et on met à jour les données de la feuille rapport
i = LigneDebut
While Not Workbooks(fichierdest).Sheets(feuilledest).Range("A" & i & "").Value = ""
'   RefPo = Range("A" & i)
   RefPo = CLng(Workbooks(fichierdest).Sheets(feuilledest).Range("A" & i & "").Value)
   'MsgBox ("Référence PO =" & RefPo)
   ' Rechercher la ligne de la RefPo dans la feuille d'extraction
   ' on compare avec la colonne B de la feuille d'extraction
   j = 2
   While Workbooks(fichier).Sheets(feuille).Range("B" & j & "").Value <> RefPo And j < LigneMaxExtraction
      j = j + 1
   Wend
   ' Si il y a une correspondance dans la feuille d'extraction
   If Workbooks(fichier).Sheets(feuille).Range("B" & j & "").Value = RefPo Then
      ' mise à jour de la feuille de rapport
      ' mise à jour du stock
      Workbooks(fichierdest).Sheets(feuilledest).Range("F" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("F" & j & "").Value
      ' mise à jour du reste J
 
      ' mise à jour du reste J+1
      Workbooks(fichierdest).Sheets(feuilledest).Range("J" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("J" & j & "").Value
      ' mise à jour du reste J+2
      Workbooks(fichierdest).Sheets(feuilledest).Range("K" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("L" & j & "").Value
      ' mise à jour du reste J+3
      Workbooks(fichierdest).Sheets(feuilledest).Range("L" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("N" & j & "").Value
      ' mise à jour du reste J+4
      Workbooks(fichierdest).Sheets(feuilledest).Range("M" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("P" & j & "").Value
      ' mise à jour du reste J+5
      Workbooks(fichierdest).Sheets(feuilledest).Range("N" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("R" & j & "").Value
      ' mise à jour du reste J+6
      Workbooks(fichierdest).Sheets(feuilledest).Range("O" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("T" & j & "").Value
      ' mise à jour du reste J+7
      Workbooks(fichierdest).Sheets(feuilledest).Range("P" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("V" & j & "").Value
      ' mise à jour du reste J+8
      Workbooks(fichierdest).Sheets(feuilledest).Range("Q" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("X" & j & "").Value
      ' mise à jour du reste J+9
      Workbooks(fichierdest).Sheets(feuilledest).Range("R" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("Z" & j & "").Value
      ' mise à jour du reste J+10
      Workbooks(fichierdest).Sheets(feuilledest).Range("S" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("AB" & j & "").Value
      ' mise à jour du reste J+11
      Workbooks(fichierdest).Sheets(feuilledest).Range("T" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("AD" & j & "").Value
      ' mise à jour du reste J
      Workbooks(fichierdest).Sheets(feuilledest).Range("U" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("AF" & j & "").Value
      ' mise à jour du reste J+1
      Workbooks(fichierdest).Sheets(feuilledest).Range("W" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("K" & j & "").Value
      ' mise à jour du reste J+2
      Workbooks(fichierdest).Sheets(feuilledest).Range("X" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("M" & j & "").Value
      ' mise à jour du reste J+3
      Workbooks(fichierdest).Sheets(feuilledest).Range("Y" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("O" & j & "").Value
      ' mise à jour du reste J+4
      Workbooks(fichierdest).Sheets(feuilledest).Range("Z" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("Q" & j & "").Value
      ' mise à jour du reste J+6
      Workbooks(fichierdest).Sheets(feuilledest).Range("AA" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("S" & j & "").Value
      ' mise à jour du reste J+7
      Workbooks(fichierdest).Sheets(feuilledest).Range("AB" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("U" & j & "").Value
      ' mise à jour du reste J+8
      Workbooks(fichierdest).Sheets(feuilledest).Range("AC" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("W" & j & "").Value
      ' mise à jour du reste J+9
      Workbooks(fichierdest).Sheets(feuilledest).Range("AD" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("Y" & j & "").Value
      ' mise à jour du reste J+10
      Workbooks(fichierdest).Sheets(feuilledest).Range("AE" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("AA" & j & "").Value
      ' mise à jour du reste J+11
      Workbooks(fichierdest).Sheets(feuilledest).Range("AF" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("AC" & j & "").Value
      ' mise à jour du reste J+12
      Workbooks(fichierdest).Sheets(feuilledest).Range("AG" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("AE" & j & "").Value
      ' mise à jour du reste J+11
      Workbooks(fichierdest).Sheets(feuilledest).Range("AH" & i & "").Value = Workbooks(fichier).Sheets(feuille).Range("AG" & j & "").Value
      ' mise à jour du reste J+12
   Else
      MsgBox ("Ref PO " & RefPo & " non trouvée dans la feuille d'extraction !")
   End If
   i = i + 1
Wend
' Stocker le dernier numéro de ligne
LigneFin = i - 1
 
' gérer la couleur des cellules
' Mettre en rouge les cellules <= 0
' Mettre en orange les cellules >0 et <=10
' Mettre en noir les cellules >10
'For Each c In Workbooks(fichierdest).Sheets(feuilledest).Range("E" & LigneDebut & ":S" & LigneFin & "")
   'If c.Value <= 0 Then
   '   c.Font.Color = RGB(255, 0, 0)
      ' remplir la cellule en rouge
    'c.Interior.ColorIndex = 3
   ' c.Interior.Pattern = xlSolid
   'ElseIf c.Value > 0 And c.Value <= 10 Then
   '   c.Font.Color = RGB(128, 0, 0)
   '  4 remplir la cellule en orange clair
   '   c.Interior.ColorIndex = 45
   '   c.Interior.Pattern = xlSolid
  ' Else
   '   c.Font.Color = RGB(0, 0, 0)
      ' Aucun remplissage
     ' c.Interior.ColorIndex = xlNone
   'End If
'Next c
 
' Fixer la date de dernière mise à jour
Workbooks(fichierdest).Sheets(feuilledest).Range("C2").Value = "Dernière date de mise à jour : " & Now
 
MsgBox ("Calcul terminé !")
 
End Sub

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
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
Sub Primaire()
''i est un numéro de ligne
Dim i As Integer
Dim a As Range, f As Range, e As Range, g As Range, z As Range, h As Range, k As Range, l As Range, m As Range, n As Range, o As Range, x As Range, p As Range, q As Range, t As Range, ab As Range, fi As Range
 
Dim j As Boolean
'idem
 
Dim ligne_début As String
 
Dim ligne_fin As String
 
Dim Ligne As Integer
'Invite pour la ligne de départ
 
    ligne_début = InputBox("Placer : Ligne début ?")
    'La ligne de début doit être numérique et supérieure ou égale à 17
 
    Do Until IsNumeric(ligne_début) And ligne_début >= 17
 
        ligne_début = InputBox("N'importe quoi! Il faut donner un numéro de ligne Supérieur ou égal à 15!!!")
 
    Loop
 
    'Invite pour la ligne de fin
 
    ligne_fin = InputBox("Placer : Ligne fin ?")
 
    'La ligne de fin doit être numérique et supérieure à la ligne de début
 
    Do Until IsNumeric(ligne_fin) And ligne_fin > ligne_début
 
        ligne_fin = InputBox("N'importe quoi! Il faut donner un numéro de ligne Supérieur à la ligne de départ. Jean-phi !!!")
 
    Loop
 
 
 
 
'Pour i de la ligne de début a la derniere ligne choisie
 
For i = ligne_début To ligne_fin
 
     'a est la CELLULE (i,2)
 
      Set a = Sheets("planning").Cells(i, 2)
 
     'f est la CELLULE (i,6)
 
      Set f = Sheets("planning").Cells(i, 6)
 
     'Si a = ""
 
      If a = "Bourrelets 84 " Then
 
          f = "priworwag"
 
         Else
 
         f = "pri2"
 
 
 
      End If
 
'Ligne suivante
 
Next i
 
 For i = ligne_début To ligne_fin
 
     'a est la CELLULE (i,5)
 
      Set a = Sheets("planning").Cells(i, 2)
 
     'f est la CELLULE (i,7)
 
      Set f = Sheets("planning").Cells(i, 6)
 
     'Si a = vide alors
 
      If a = "" Then
 
         f = ""
 
      End If
 
'Ligne suivante
 
Next i
For i = ligne_début To ligne_fin
 
     'a est la CELLULE (i,5)
 
      Set a = Sheets("planning").Cells(i, 220)
 
     'f est la CELLULE (i,7)
 
      Set f = Sheets("planning").Cells(i, 221)
      Set e = Sheets("planning").Cells(i, 223)
      Set z = Sheets("planning").Cells(i, 224)
      Set h = Sheets("planning").Cells(i, 225)
      Set t = Sheets("planning").Cells(i, 227)
      Set k = Sheets("planning").Cells(i, 228)
      Set l = Sheets("planning").Cells(i, 229)
      Set m = Sheets("planning").Cells(i, 230)
      Set n = Sheets("planning").Cells(i, 231)
      Set o = Sheets("planning").Cells(i, 232)
      Set x = Sheets("planning").Cells(i, 233)
      Set q = Sheets("planning").Cells(i, 234)
 
     'Si a = vide alors
 
      If a = "" Then
 
         f = "durcisseur"
         e = "0"
         z = "0"
         h = "0"
         t = "0"
         k = "1"
         l = "1"
         m = "1"
         n = "1"
         o = "1"
         x = "1"
         q = "1"
 
 
 
      End If
 
'Ligne suivante
 
Next i
 
For i = ligne_début To ligne_fin
 
     'a est la CELLULE (i,4)
 
      Set a = Sheets("planning").Cells(i, 2)
 
     'f est la CELLULE (i,5)
 
      Set f = Sheets("planning").Cells(i, 7)
 
     'Si a = "Salut"
 
      If a = "BOUR AR E84" Then
 
          f = "Vernis mat"
 
         Else
 
         f = "vernis"
 
 
      End If
 
'Ligne suivante
 
Next i
 
 For i = ligne_début To ligne_fin
 
     'a est la CELLULE (i,5)
 
      Set a = Sheets("planning").Cells(i, 2)
 
     'f est la CELLULE (i,7)
 
      Set f = Sheets("planning").Cells(i, 7)
 
     'Si a = vide alors
 
      If a = "" Then
 
         f = ""
 
      End If
 
'Ligne suivante
 
Next i
 
For i = ligne_début To ligne_fin
 
     'a est la CELLULE (i,5)
 
      Set ab = Sheets("planning").Cells(13, 14)
 
     'f est la CELLULE (i,7)
 
      Set fi = Sheets("planning").Cells(i, 8)
 
     'Si a = vide alors
 
      If ab = "jour" Then
 
         fi = "12"
 
      End If
 
'Ligne suivante
 
Next i
 
End Sub

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
67
68
69
70
71
72
73
74
75
76
77
78
Public ligne_vide As Integer
Public ligne_debut As Integer
Public ligne_fin As Integer
Public vide As Boolean
Sub contrainte()
Dim Ligne
ligne_debut = InputBox("Début de tri")
Ligne = ligne_debut
ligne_fin = InputBox("Fin de tri")
    Do While Ligne <> ligne_fin
    If Cells(Ligne, 5).Value = "broy" And Cells(Ligne + 1, 5).Value = "nnac" Or _
    Cells(Ligne, 5).Value = "rvif" And Cells(Ligne + 1, 5).Value = "bgla" Then
            Rows(Ligne + 1).Insert
            ligne_fin = ligne_fin + 1
    End If
    Ligne = Ligne + 1
Loop
chercher_cellulevide
If vide = True Then
    ligne_fin_cut = ligne_fin
    Do
        If Cells(ligne_fin_cut, 5).Value <> "nnac" And Cells(ligne_fin_cut - 1, 5).Value <> "broy" Or _
        Cells(ligne_fin_cut, 5).Value <> "bgla" And Cells(ligne_fin_cut - 1, 5).Value <> "rvif" Then
            Rows(ligne_fin_cut).Cut
            recherche_vide
            Rows(ligne_vide).Insert
            If ligne_vide > ligne_fin_cut Then
                Rows(ligne_vide).Delete
            Else
                Rows(ligne_vide + 1).Delete
            End If
            ligne_fin = ligne_fin - 1
            vide = False
            chercher_cellulevide
        Else
            ligne_fin_cut = ligne_fin_cut - 1
        End If
    Loop While vide = True And ligne_fin_cut <> ligne_debut
    chercher_cellulevide
 
End If
 
 
 
 
    Range("A18").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(R[-1]C<>"""",R[-1]C[8]<>0,RC[8]<>0),R[-1]C+(R[-1]C[8]+1)*tps,"""")"
    Selection.AutoFill Destination:=Range("A18:A" & ligne_fin), Type:=xlFillDefault
    Range("K18").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+RC[-2]"
    Selection.AutoFill Destination:=Range("K18:K" & ligne_fin), Type:=xlFillDefault
 
End Sub
Sub recherche_vide()
'Cherche la ligne de la cellule vide
Ligne = ligne_debut
Do While Ligne <> ligne_fin
    If Cells(Ligne, 5).Value = "" Then
        ligne_vide = Ligne
        Exit Do
    Else
        Ligne = Ligne + 1
    End If
 
Loop
 
End Sub
Sub chercher_cellulevide()
'Cherche s'il existe une cellule vide
For i = ligne_debut To ligne_fin
    If Cells(i, 5).Value = "" And Cells(i + 1, 5).Value <> "" Then
        vide = True
        Exit For
    End If
Next i
 
End Sub

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
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
Option Explicit
Sub copier()
 
 
 
Dim WSSource As Worksheet
 
Dim WSDest As Worksheet
Dim WSDest2 As Worksheet
 
Dim i As Integer
 
Dim j As Boolean
 
Dim ligne_début As String
 
Dim ligne_fin As String
 
Dim Ligne As Integer
 
 Dim cell As String
'Invite pour la ligne de départ
 
    ligne_début = InputBox("Placer : Ligne début ?")
 
    'La ligne de début doit être numérique et supérieure ou égale à 17
 
    Do Until IsNumeric(ligne_début) And ligne_début >= 17
 
        ligne_début = InputBox("N'importe quoi! Il faut donner un numéro de ligne Supérieur ou égal à 15!!!")
 
    Loop
 
    'Invite pour la ligne de fin
 
    ligne_fin = InputBox("Placer : Ligne fin ?")
 
    'La ligne de fin doit être numérique et supérieure à la ligne de début
 
    Do Until IsNumeric(ligne_fin) And ligne_fin > ligne_début
 
        ligne_fin = InputBox("N'importe quoi! Il faut donner un numéro de ligne Supérieur à la ligne de départ. Patate !!!")
 
    Loop
 
 
 
 
 
 
 Set WSSource = Workbooks("ruitz.xls").Worksheets("planning")
 
Set WSDest = Workbooks("planning").Worksheets("planning")
Set WSDest2 = Workbooks("planning").Worksheets("planning")
 
 
'Boucle pour chaque ligne
 
For Ligne = ligne_début To ligne_fin
 
 
 
'cherche la ligne vide dans le classeur de destination
 
    i = WSDest.Range("A65536").End(xlUp).Row + 1
 
 
 
'On copie les cellules E,ligne, K ligne et Nligne ->Q ligne
 
 
 
 
    cell = Cells(i, 3).Address
    WSSource.Cells(Ligne, 2).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 7).Address
    WSSource.Cells(Ligne, 5).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 5).Address
    WSSource.Cells(Ligne, 6).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 8).Address
    WSSource.Cells(Ligne, 7).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 19).Address
    WSSource.Cells(Ligne, 12).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 16).Address
    WSSource.Cells(Ligne, 8).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 17).Address
    WSSource.Cells(Ligne, 10).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
   cell = Cells(i, 18).Address
    WSSource.Cells(Ligne, 11).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 9).Address
    WSSource.Cells(Ligne, 221).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 1).Address
    WSSource.Cells(Ligne, 223).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 2).Address
    WSSource.Cells(Ligne, 224).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 4).Address
    WSSource.Cells(Ligne, 225).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 6).Address
    WSSource.Cells(Ligne, 227).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 9).Address
    WSSource.Cells(Ligne, 228).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 10).Address
    WSSource.Cells(Ligne, 229).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 11).Address
    WSSource.Cells(Ligne, 230).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 12).Address
    WSSource.Cells(Ligne, 231).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 13).Address
    WSSource.Cells(Ligne, 232).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 14).Address
    WSSource.Cells(Ligne, 233).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 15).Address
    WSSource.Cells(Ligne, 234).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
Next
 
For Ligne = ligne_début To ligne_fin
 
 
 
'cherche la ligne vide dans le classeur de destination
 
    i = WSDest2.Range("A65536").End(xlUp).Row + 1
 
 
 
'On copie les cellules E,ligne, K ligne et Nligne ->Q ligne
 
 
 
 
    cell = Cells(i, 3).Address
    WSSource.Cells(Ligne, 2).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 7).Address
    WSSource.Cells(Ligne, 5).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 5).Address
    WSSource.Cells(Ligne, 6).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 8).Address
    WSSource.Cells(Ligne, 7).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 19).Address
    WSSource.Cells(Ligne, 12).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 16).Address
    WSSource.Cells(Ligne, 8).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 17).Address
    WSSource.Cells(Ligne, 10).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
   cell = Cells(i, 18).Address
    WSSource.Cells(Ligne, 11).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
cell = Cells(i, 9).Address
    WSSource.Cells(Ligne, 221).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
    cell = Cells(i, 1).Address
    WSSource.Cells(Ligne, 223).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 2).Address
    WSSource.Cells(Ligne, 224).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 4).Address
    WSSource.Cells(Ligne, 225).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 6).Address
    WSSource.Cells(Ligne, 227).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 9).Address
    WSSource.Cells(Ligne, 228).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 10).Address
    WSSource.Cells(Ligne, 229).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 11).Address
    WSSource.Cells(Ligne, 230).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 12).Address
    WSSource.Cells(Ligne, 231).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 13).Address
    WSSource.Cells(Ligne, 232).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 14).Address
    WSSource.Cells(Ligne, 233).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
    cell = Cells(i, 15).Address
    WSSource.Cells(Ligne, 234).Copy
    WSDest2.Range(cell).PasteSpecial Paste:=xlValues, Operation:=xlNone
 
Next
 
 
 
 
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
Option Explicit
Sub Imprimer()
 
 
Workbooks("planning.xls").Worksheets("planning").PrintOut
 
 
End Sub