Probleme bei Funktion ReDim

Hallo Leute,
Ich habe mit Hilfe vom Forum hier vor längerer Zeit ein Makro erstellt, das mir dateien öffnet & reinkopiert.
Funktioniert alles so weit super, bis auf den Laptop eines Kollegen, wenn er das Script vom Netzlaufwerk aus startet, funktioniert das ganze Ding, startet er es von LOKAL aus bekomme ich einen Laufzeitfehler 9, index ausserhalb des gültigen Bereichs bei
" ReDim Monatsdateien(1 To .FoundFiles.Count)"
Ordnerstruktur von Netzlaufwerk wurde auf LOKAL kopiert.
ich hab das ganze jetzt mit meinen PC ausprobiert und da funktioniert das alles.
Anbei der Script.
Da der Script schon mal online steht, weiss jemand wie ich diesen script verändern könnte um das problem mit Application.Filesearch unter Excel 2007 in den Griff zu bekommen?


Sub Forecast_einlesen()
ApplicationUpdate = False
Application.Calculation = xlCalculationManual
Selection.AutoFilter 'Setzt den Autofilter zurück!
Range("A17:L17").Select 'Geht zum ersten Feld des Bereiches
Selection.AutoFilter 'Setzt neuen Autofilter, ohne zu selektieren
Dim Datname As Workbook, wksZiel As Worksheet, Monatsdateien() As Workbook
Dim iCounter As Integer, lZeileZiel As Long, wksquelle As Worksheet
Set Datname = ActiveWorkbook
Set wksZiel = Sheets("BASIC_forecasts ")
wksZiel.Select
With Application.FileSearch
.LookIn = ThisWorkbook.Path & "\Details-Forecast "
.SearchSubFolders = False
.Execute msoSortByFileType
.FileType = msoFileTypeExcelWorkbooks
ReDim Monatsdateien(1 To .FoundFiles.Count)
For iCounter = 1 To .FoundFiles.Count
Workbooks.Open Filename:= _
.FoundFiles(iCounter) _
, UpdateLinks:=0
Set Monatsdateien(iCounter) = ActiveWorkbook
Next iCounter
End With
Datname.Activate
With wksZiel
.Range(.Cells(18, 1), .Cells(18, 1).End(xlDown).Offset(0, 11)).ClearContents
lZeileZiel = 18
For iCounter = 1 To UBound(Monatsdateien)
Set wksquelle = Monatsdateien(iCounter).Worksheets(2)
wksquelle.Range(wksquelle.Cells(19, 1), _
wksquelle.Cells(19, 1).End(xlDown).Offset(0, 11)).Copy
'      .Cells(lZeileZiel, 1).PasteSpecial Paste:=xlFormats
.Cells(lZeileZiel, 1).PasteSpecial Paste:=xlValues
lZeileZiel = .Cells(lZeileZiel, 1).End(xlDown).Row + 1
Application.CutCopyMode = False
Monatsdateien(iCounter).Close
Next
End With
ApplicationUpdate = True
Application.Calculation = xlCalculationAutomatic
Range("N19:O19").Select
Selection.Copy
Range("A18:B18").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("PIVOT_Forecast").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
End Sub

vorab schon mal danke
LG
Rupert

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub mehrere_arbeitsmappen_oeffnen() Dim strVerzeichnis As String Dim strDatei As String Dim strTyp As String Dim strDateiname As String Dim loZeile As Long strTyp = "*.xls" Application.ScreenUpdating = False strVerzeichnis = Worksheets("Tabelle1").Cells(2, 1) If Right(strVerzeichnis, 1) "\" Then strVerzeichnis = strVerzeichnis & "\" strDateiname = Dir(strVerzeichnis & strTyp) loZeile = 6 With ThisWorkbook.Worksheets("Tabelle1") Do While strDateiname "" Workbooks.Open Filename:=strVerzeichnis & strDateiname .Cells(loZeile, 1) = ActiveWorkbook.ActiveSheet.Cells(12, 1) ActiveWorkbook.Close True strDateiname = Dir loZeile = loZeile + 1 Loop End With Application.ScreenUpdating = True End Sub

Hi Rupert,
wenn ich deinen Code richtig verstanden habe, dann werden alle Dateien, die in einem bestimmten Verzeichnis liegen, geöffnet und in ein Array geschrieben. Anschließend werden aus alle Dateien, die in diesem Array stehen, nacheinander bestimmte Zellen eines definierten Tabellenblattes fortlaufend übernommen sowie die betreffende Arbeitsmappe wieder geschlossen. Da steht nichts von einem vorher ausgewählten Datum drin.
Mein Code öffnet nacheinander alle in einem vorgegebenen Verzeichnis liegenden Arbeitsmappen, übernimmt den Wert aus A12 der gerade aktiven Tabelle und schließt diese Arbeitsmappe wieder. Mein Code macht also nichts anderes als deiner, nur ist er wesentlich kürzer (weil kein Einlesen in das Array erfolgt) und auch in Excel2007 einsetzbar (weil ohne FileSearch).

Sub mehrere_arbeitsmappen_oeffnen() Dim strVerzeichnis As String Dim strDatei As String Dim strDateiname As String Dim strTyp As String Dim loLetzte1 As Long Dim loLetzte2 As Long strTyp = "*.xls" Application.ScreenUpdating = False strVerzeichnis = Worksheets("Tabelle1").Cells(2, 1) If Right(strVerzeichnis, 1) "\" Then strVerzeichnis = strVerzeichnis & "\" strDateiname = Dir(strVerzeichnis & strTyp) With ThisWorkbook.Worksheets("Tabelle1") Do While strDateiname "" Workbooks.Open Filename:=strVerzeichnis & strDateiname loLetzte1 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp). _ Row, .Rows.Count) + 1 With ActiveWorkbook.ActiveSheet loLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp) _ .Row, .Rows.Count) .Range(.Cells(1, 1), .Cells(loLetzte2, 12)).Copy ThisWorkbook.Worksheets(" _ Tabelle1").Cells(loLetzte1, 1) End With ActiveWorkbook.Close True strDateiname = Dir Loop End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread