Sub parcourir()
Dim S As Worksheet
Dim A$
Dim R As Range
Dim T()
Dim var
Dim pos&
Dim nbLig&
Dim cpt&
Dim g&
Dim i&
Dim j&
Set S = Worksheets("RecapCommande")
Set R = S.Range("ZoneRecapCommande").SpecialCells(xlCellTypeVisible)
A$ = R.Address
pos& = InStr(1, A$, ",")
If pos& = 0 Then
var = R
Else
A$ = A$ & ","
cpt& = 1
Do
pos& = InStr(1, A$, ",")
If pos& = 0 Then Exit Do
Set R = S.Range(Mid(A$, 1, pos& - 1))
var = R
nbLig& = nbLig& + R.Rows.Count
ReDim Preserve T(1 To UBound(var, 2), 1 To nbLig&)
For j& = cpt& To nbLig&
g& = g& + 1
For i& = 1 To UBound(T, 1)
T(i&, j&) = var(g&, i&)
Next i&
Next j&
cpt& = cpt& + g&
g& = 0
A$ = Mid(A$, pos& + 1)
Loop
var = Application.WorksheetFunction.Transpose(T)
End If
A$ = ""
'--- Si différents N° de commande ---
For i& = 2 To UBound(var, 1)
If var(i&, 4) <> var(1, 4) Then
A$ = "Plusieurs commandes veuillez en filtrer une seule !"
Exit For
End If
Next
'--- Si différents fournisseurs ---
For i& = 2 To UBound(var, 1)
If var(i&, 1) <> var(1, 1) Then
A$ = "Fournisseurs différents sur même bon veuillez en filtrer un seul !"
Exit For
End If
Next
If A$ = "" Then A$ = "C'est OK !"
MsgBox A$
End Sub