Option Explicit
Sub Impression()
Dim i As Long, j As Long, Nb As Long, NbD As Long
Dim Wsh As Worksheet, WshAct As Worksheet, s As String, Ar() As String
Application.ScreenUpdating = False
Erase Ar
For Each Wsh In ThisWorkbook.Worksheets
ReDim Preserve Ar(i)
If Wsh.Visible = -1 Then
Ar(i) = Wsh.Name
i = i + 1
End If
Next Wsh
s = ActiveSheet.Name
If InStr(s, "BL Mobile") > 0 Then
Set WshAct = Worksheets(s)
For i = 11 To 15
NbD = NbCh(WshAct.Range("BS" & i))
s = Left$(WshAct.Range("BS" & i), NbD)
WshAct.Range("BS" & i) = s & WshAct.Range("BM3")
Next i
j = 11
For i = LBound(Ar) To UBound(Ar)
Set Wsh = Worksheets(Ar(i))
If WshAct.Range("BS" & j) = Ar(i) Then
Nb = WshAct.Range("CD" & j)
If Nb > 0 Then Wsh.PrintOut copies:=Nb ', Collate:=False
j = j + 1
End If
Next i
WshAct.Select
Else
MsgBox "Sélectionnez une feuille BL Mobile" & vbCrLf & "Puis cliquez sur le bouton Impression", vbOKOnly + vbInformation
End If
Application.ScreenUpdating = True
End Sub
Private Function NbCh(s As String) As Long
Dim i As Long, Ch As String
For i = 1 To Len(s)
Ch = Mid$(s, i, 1)
If Asc(Ch) >= 48 And Asc(Ch) <= 57 Then Exit For
Next i
NbCh = i - 1
End Function