Hallo Holger,
ich habe den Code nochmal von Grund auf Kontrolliert und bin diesen Schritt für Schritt durchgegangen.
Das Verzeichnis wird richtig angesprochen, es macht keinen Unterschied ob ich ThisWorkbook.Path oder den direkten Pfad verwende.
Ich bin nun auch soweit, dass er die erste Datei findet und ordnungsgemäß ausliest und dann auch ohne nachfrage des speicherns wieder schließt, aber dann findet er die zweite Datei nicht mehr.
Zur Info - Die Dateien liegen alle im selben Ordner.
Ich habe den Code nocheinmal beigefügt der derzeit verwendet wird.
Vielleicht ist der Einsprungsort nach dem der Vorgang für die erste Datei gelaufen ist falsch ? Nur so eine Idee ???
Gruß Sascha
ChDir ThisWorkbook.Path '-----------------------------------------
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iSINW As Integer, iRow As Integer
Dim rZelle As Range, rBereich As Range
Dim sRange As String
sRange = "B2,B3,B7,B36,B27,D27,B28,D28,B29,D29,B30,D30,B17,D17,B18,D18,B19,D19"
iRow = 1
iCol = 1
iSINW = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set WS2 = Workbooks.Add.ActiveSheet
Application.SheetsInNewWorkbook = iSINW
Application.ScreenUpdating = False
With WS2
Wbs = Array("1000.xls", "3000.xls") '---------------------------
For Each Wb In Wbs
Workbooks.Open Wb '-----------------------------------------
For Each WS1 In Workbooks(Wb).Worksheets '-------------------------------------------
If Len(WS1.Name) > 3 Then
Set rBereich = WS1.Range(sRange)
.Cells(iRow, iCol) = WS1.Name
For Each rZelle In rBereich
iCol = iCol + 1
With .Cells(iRow, iCol)
.Value = rZelle.Value
.NumberFormat = rZelle.NumberFormat
End With
Next
Set rZelle = Nothing
iRow = iRow + 1
iCol = 1
End If
Next WS1
Workbooks(Wb).Close savechages = False '---------------------------------------
Next '---------------------------------------
.Name = "Übersicht"
End With
Application.ScreenUpdating = True
MsgBox "Übersicht wurde fertig erstellt.", vbOKOnly, "Info"
Exit Sub
Fehler:
MsgBox "Übersicht konnte nicht vollständig erstellt werden.", vbOKOnly, "Achtung"
Application.ScreenUpdating = True
|