Tabellenblätter überprüfen
mari
ich bin an einem Makro dran, der ein Ordner nach XLS Dateien durchsucht.
Soweit so gut.
Die XLS Dateien sollen dann geprüft werden und zwar nach den Tabellenblättern.
Ist in einem Sheet mehr als ein Tabellenblatt vorhanden, soll mir der Name der Datei in einer neuen Tabelle aufgeführt werden.
Von Franz aus dem Forum hier habe ich schon den ersten Teil (Danke): Sprich den Arbeitsplatz öffnen und den entsprechenden Ordner mit den Dateien auswählen.
Es fehlt mir nur noch die Überprüfung sowie die Ausgabe. Ich hoffe ihr könnt mir weiter helfen.
Sub Tabellenblattauslesen()
Dim sVerzeichnis$, sDatei$
Dim wbZiel As Workbook, wbQuelle As Workbook
Dim wksZiel As Worksheet, wksQuelle As Worksheet
On Error GoTo Fehler
'Suchverzeichnis auswahlen
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Ordner mit zu durchsuchenden Dateien wählen"
.ButtonName = "Auswälen"
If .Show = -1 Then
sVerzeichnis = .SelectedItems(1)
sDatei = Dir(sVerzeichnis & Application.PathSeparator & "*.xl*")
If sDatei "" Then
'neue Datei mit einem Tabellenblatt für Ergebnisdaten erstellen
Set wbZiel = Workbooks.Add(Template:=xlWBATWorksheet)
'Zieltabellenblatt Objektvariable zuweisen
Set wksZiel = wbZiel.Worksheets(1)
ZeileZ = 1
With wksZiel
'Titelzeile ausfüllen
.Cells(ZeileZ, 3) = "Dateiname"
End With
End If
Application.ScreenUpdating = False
End If
End With
Set wbZiel = Nothing
Set wbQuelle = Nothing
Application.StatusBar = False
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
Application.ScreenUpdating = True
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
If Not wbQuelle Is Nothing Then wbQuelle.Close savechanges:=False
End Select
End With
End Sub