vba Ordner auf leer prüfen

Sub kopieren()
Dim ziel As String, versuch As String, quelle As Variant, sht As String, i As Integer
versuch = ActiveWorkbook.Path & "\Versuche"
ziel = ThisWorkbook.Name
ChDrive Left(ActiveWorkbook.Path, 1) 'aktuelles LW aktivieren
If Dir(versuch, vbDirectory) = "" Then 'falls Unterordner "Versuche" nicht existiert ->  _
anlegen
MkDir (versuch)
MsgBox "Es wurde ein Ordner für die Versuche angelegt"
End If
'---- hier vielleicht die Abfrage?
ChDir versuch 'in aktuellen Pfad wechseln
quelle = Application.GetOpenFilename("Excel-Dateien (*.xls*),*.xls*", , "Datei auswählen",  _
MultiSelect:=False)
Workbooks.Open quelle
sht = ActiveWorkbook.Name
For i = 1 To Worksheets.Count 'Tabellen kopieren in Zieldatei hinter Tabelle 3 einfügen
Workbooks(sht).Sheets(i).Copy After:=Workbooks(ziel).Sheets(i + 2)
Next i
Workbooks(sht).Close
For i = 4 To Worksheets.Count 'Tabellen nach Position in Zieldatei benennen (nummerieren)
Worksheets(i).Activate
ActiveSheet.Name = i
Next i
Worksheets(1).Activate 'Tabellennamen in Tabelle "Start" ab Zelle A3 als Liste eintragen
For i = 3 To ActiveWorkbook.Sheets.Count
Sheets("Start").Range("A" & i) = Sheets(i).Name
Next
End Sub