Hallo Sascha L.,
vielleicht liegt es daran, dass "1000.xls", "2000.xls" nicht in dem Verzeichnis liegen, in dem das geöffnete Workbook steht.
Also
Ersetze
ChDir ThisWorkbook.Path
durch
Pfad="C:\dokumente und einstellungen\......\" 'Pfad zu 1000.xls einschließkich letztem \
und
Workbooks.Open Wb
durch
Workbooks.Open pfad & Wb
Gruß
Holger
Sascha L. schrieb am 02.09.2009 12:13:44:
Hallo Holger,
auch unter Angabe des Arrays wie unten beschrieben funktioniert es nicht.
Es stoppt bei
Workbooks.Open Wb
mit Laufzeitfehler 1004
Irgendetwas mache ich doch sicher falsch ...
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", "2000.xls")
Workbooks.Open Wb
For Each Wb In Wbs
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
Next
.Name = "Übersicht"
WS2.Columns.AutoFit
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
|