Sub degards()
x = 0
For i = 1 To 11
Worksheets("Imprim" & i).Cells.Delete
Next
For i = 9 To Sheets(1).Range("L35").End(xlUp).Row Step 2
If IsError(Sheets(1).Cells(i, 12).Value) Then GoTo pass
If Sheets(1).Cells(i, 12).Value <> "" Then
Sheets(1).Cells(2, 13) = Sheets(1).Cells(i, 12) & " " & Sheets(1).Cells(i, 12).Offset(-1, 0)
x = x + 1
CreePage x
End If
pass:
Next
'' C'est à partir d'ici que j'ai besoin d'aide
If Sheets(1).Cells(31, 1) <> "" Then
Sheets(1).Cells(2, 13) = Sheets(1).Cells(31, 1) & " " & Sheets(1).Cells(30, 1)
Sheets(1).Cells(3, 13) = "AGENT MULTI"
x = x + 1
CreePage x
End If
If Sheets(1).Cells(33, 1) <> "" Then
Sheets(1).Cells(2, 13) = Sheets(1).Cells(33, 1) & " " & Sheets(1).Cells(32, 1)
Sheets(1).Cells(3, 13) = "AGENT MULTI"
x = x + 1
CreePage x
End If
If Sheets(1).Cells(31, 5) <> "" Then
Sheets(1).Cells(2, 13) = Sheets(1).Cells(31, 5) & " " & Sheets(1).Cells(30, 5)
Sheets(1).Cells(3, 13) = "AGENT MULTI"
x = x + 1
CreePage x
End If
If Sheets(1).Cells(33, 5) <> "" Then
Sheets(1).Cells(2, 13) = Sheets(1).Cells(33, 5) & " " & Sheets(1).Cells(32, 5)
Sheets(1).Cells(3, 13) = "AGENT MULTI"
x = x + 1
CreePage x
End If
Sheets(1).Cells(2, 13) = ""
Sheets(1).Cells(3, 13) = ""
'*** lancement de l'impression
Lance = Application.Dialogs(xlDialogPrint).Show
If Lance = True Then
For i = 1 To 11
If Worksheets("Imprim" & i).Range("C1") <> "" Then
'Worksheets("Imprim" & i).PrintOut
Worksheets("Imprim" & i).PrintPreview
End If
Next
End If
'*** effacement des feuilles d'impression
For i = 1 To 11
Worksheets("Imprim" & i).Cells.Delete
Next
End Sub