recherche dossier avec inconnue

Sub pmo_RechercheDossiers()
Dim var
Dim Chemin$
Dim Cible$
Dim Dossier$
Dim cpt&
Dim T()
var = InputBox("Tapez le nom d'un chemin (ex : c:\program files\mic*)", _
    "Recherche de dossier(s) avec le générique *")
If var = "" Then Exit Sub
If Right(var, 1) = "\" Then
  Chemin$ = var
Else
  Chemin$ = Mid(var, 1, InStrRev(var, "\"))
  If Right(var, 1) = "*" Then
    Cible$ = Trim(Mid(var, Len(Chemin$) + 1, Len(var) - Len(Chemin$) - 1))
  End If
End If
If Chemin$ = "" Then Exit Sub
Dossier$ = Dir(Chemin$, vbDirectory)
Do While Dossier$ <> ""
  If Cible$ <> "" Then
    If LCase(Cible$) = LCase(Mid(Dossier$, 1, Len(Cible$))) Then
      GoSub Traitement
    End If
  Else
    GoSub Traitement
  End If
  Dossier$ = Dir
Loop
If cpt& > 0 Then
  Sheets.Add after:=Sheets(Sheets.Count)
  Range("a1:a" & cpt& & "") = Application.WorksheetFunction.Transpose(T)
End If
Exit Sub
Traitement:
If Dossier$ <> "." And Dossier$ <> ".." Then
  If (GetAttr(Chemin$ & Dossier$) And vbDirectory) = vbDirectory Then
    cpt& = cpt& + 1
    ReDim Preserve T(1 To 1, 1 To cpt&)
    T(1, cpt&) = Dossier$
  End If
End If
Return
End Sub