Public Sub MacroRechercheDossierScope()
Dim StringFinal As Variant
Dim NoDossier As String
Dim Dif As Integer
Dim I As Integer
I = 0
StringFinal = "number="
For Each Cell In Selection
If Feuil1.Cells(Selection.Row + I, Selection.Column) <> "" Then
NoDossier = ""
If (Len(Feuil1.Cells(Selection.Row + I, Selection.Column)) < 9 And Left(Feuil1.Cells(Selection.Row + I, Selection.Column), 1) = "Q" And IsNumeric(Right(Feuil1.Cells(Selection.Row + I, Selection.Column), Len(Feuil1.Cells(Selection.Row + I, Selection.Column)) - 1)) = True) Or (Len(Feuil1.Cells(Selection.Row + I, Selection.Column)) < 8 And Left(Feuil1.Cells(Selection.Row + I, Selection.Column), 1) <> "Q" And IsNumeric(Feuil1.Cells(Selection.Row + I, Selection.Column)) = True) Then
If Left(Feuil1.Cells(Selection.Row + I, Selection.Column), 1) = "Q" Then
Dif = 9 - Len(Feuil1.Cells(Selection.Row + I, Selection.Column))
For J = 1 To Dif
NoDossier = NoDossier + "0"
Next
NoDossier = Left(Feuil1.Cells(Selection.Row + I, Selection.Column), 1) + NoDossier + Right(Feuil1.Cells(Selection.Row + I, Selection.Column), Len(Feuil1.Cells(Selection.Row + I, Selection.Column)) - 1)
Else
Dif = 8 - Len(Feuil1.Cells(Selection.Row + I, Selection.Column))
For J = 1 To Dif
NoDossier = NoDossier + "0"
Next
NoDossier = "Q" + NoDossier + CStr(Feuil1.Cells(Selection.Row + I, Selection.Column))
End If
StringFinal = StringFinal + Chr(34) + NoDossier + Chr(34) + " or number ="
End If
I = I + 1
Else
I = I + 1
End If
Next
If StringFinal = "number=" Then
MsgBox ("Aucune des cellules selectionnées ne contient de numéro de dossier")
Else
StringFinal = Left(StringFinal, Len(StringFinal) - 12)
Feuil1.Cells(1, 1).WrapText = False
Feuil1.Cells(1, 1) = StringFinal
Feuil1.Cells(1, 1).Copy
End If
End Sub