Guten Tag, Im Zuge meiner Bachelorarbeit soll ich ein Suchscript schreiben um Daten für eine Statistik leichter zu sammeln.
Mein Programm ist bisher gelaufen aber ich habe es durch den kommentierten Bereich in der Mitte des Codes erweitert und nun bekomme ich die Fehlermeldung "Loop ohne Do"
Bisher ist das Programm xlsx Dateien in einem Pfad durchgegangen un hat die angegebene Range in ein neu erstelltes Sheet eingefügt.
Dieses Sheet wurde dann auch nach der Datei benannt und so wurden die Gesuchten Daten immerwieder in ein neues Sheet eingefügt.
Klasse Sache. Das Problem ist nur das in den gesuchten Dateien nicht immer das Sheet "Beutel(bag)" vorhanden ist, deshalb soll das Programm überprüfen ob das Sheet vorhanden ist, sonst soll es weitersuchen.
Ich bin leider noch neu in VBA
Visual Basic-Quellcode
- Sub Mehrere_Dateien_einlesen()
- Dim strFile As String
- strPath = "C:\Users\youne\Desktop\Wartungsprotokolle\Data\253-2134\A3_181207_004\"
- strExt = "*.xlsx"
- If strPath = "" Then
- Exit Sub
- Else
- strFile = Dir(strPath & strExt)
- Do While Len(strFile) > 0
- Workbooks.Open Filename:=strPath & strFile
- 'Dieser Teil ist neu
- TotalSheets = ThisWorkbook.Worksheets.Count
- For Each ws In ThisWorkbook.Sheets
- CheckSheet = ThisWorkbook.Worksheets("Beutel(bag)")
- For i = 1 To TotalSheets
- If ThisWorkbook.Worksheets(i).Name = CheckSheet Then
- ThisWorkbook.Worksheets("Beutel(bag)").Activate
- End If
- 'Bis hier
- Workbooks(strFile).Worksheets("Beutel(bag)").Range("B73,F73:I73,B90,F90:I90,B91,F91:I91").Copy
- ThisWorkbook.Worksheets.Add.Name = strFile
- ThisWorkbook.Worksheets(strFile).Range("A1").PasteSpecial Paste:=xlValues
- Workbooks(strFile).Close False
- strFile = Dir()
- Loop
- End If
- End Sub
Verschoben. Code-Tags eingefügt. ~Thunderbolt
