Hallo Sascha,
du hast
Workbooks.Open Wb
vergessen.
Gruß
Holger
Sascha L. schrieb am 26.08.2009 14:08:49:
Hallo Holger,
danke für die schnelle Antwort
Jetzt erhalte ich in der gleichen Zeile den Fehler
Laufzeitfehler 9 - Index außerhalb des Gültigen bereichs
Ich habe hier nochmal den derzeit verwendeten Code,
eventuell habe ich den Bereich auch falsch deklariert ???
Private Sub Uebersicht_Click()
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,3000.xls,4000.xls,5000.xls,6000.xls")
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
End Sub
Gruß Sascha |