Hallo M.O.!
Du entschuldige ich war eine Woche im Urlaub...
Vielleicht versuch ich es nochmal genauer zu erklären ;)
In dem Ordner in welchem sich die Arbeitsmappe mit dem Makro befindet möchte ich zirka 200 Excel-Dateien mit dem gleichen Format einfügen. Diese sollen dann mittels Makro
fixierte Zellen aus den jeweiligen Dateien lesen und verarbeiten. Sind alle Dateien ok, entferne ich alle Dateien aus dem Ordner und füge beispielsweise 150 neue Dateien ein, die
dann geprüft werden sollen. Dieser Prozess wiederholt sich immer und immer wieder. Vielleicht nochmal mein bisheriger Makro:
Sub verknuepfungen()
'
' verknuepfungen Makro
'
Dim zeile As Long
Dim pfad As String
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'Pfad festlegen = Pfad der aktuellen Arbeitsmappe
pfad = ThisWorkbook.Path
'Schleife für das Erstellen der Verknüpfungen
'Beginnt ab Zeile 1 bis zur letzten beschriebenen Zeile
For zeile = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'Falls Zelle nicht leer ist, werden die Verknüpfungen eingefügt
If IsEmpty(Cells(zeile, 1)) = False Then
ActiveSheet.Cells(zeile, 4).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Text & "]Sheet1'!C$2"
ActiveSheet.Cells(zeile, 5).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!C$7"
ActiveSheet.Cells(zeile, 6).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!D$11"
ActiveSheet.Cells(zeile, 7).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$15"
ActiveSheet.Cells(zeile, 8).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$16"
ActiveSheet.Cells(zeile, 9).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$17"
ActiveSheet.Cells(zeile, 11).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$10"
ActiveSheet.Cells(zeile, 12).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$11"
ActiveSheet.Cells(zeile, 13).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$2"
ActiveSheet.Cells(zeile, 14).FormulaLocal = "='" & pfad & "\[" & Cells(zeile, 1).Value & "]Sheet1'!B$3"
End If
Next zeile
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
Application.Goto Reference:="verknuepfungen"
ActiveWorkbook.Save
Range("C1:G8").Select
Range("C8").Activate
Selection.ClearContents
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range("C1:G9").Select
Range("G9").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("H12").Select
Application.Run "Formeltabelle.xlsm!verknuepfungen"
Sheets("Angebot").Select
Sheets("Angebot").Name = "Sheet1"
Range("A37").Select
ActiveWorkbook.Save
ActiveWindow.Close
Range("E6").Select
Application.Run "Formeltabelle.xlsm!verknuepfungen"
Application.WindowState = xlMinimized
ActiveWindow.Close
Application.WindowState = xlMinimized
Application.WindowState = xlMinimized
ActiveWindow.Close
Range("C23").Select
ActiveWindow.SmallScroll Down:=-6
Windows("0447-2012-12-S-687660030001-2012024025.xlsx").Activate
Windows("0440-2012-12-S-974370010001-2012024121.xlsx").Activate
Windows("0439-2012-12-S-611910010001-2012024000.xlsx").Activate
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.SmallScroll Down:=-3
Application.WindowState = xlMinimized
Windows("0413-2012-12-S-745640030001-2012024047.xlsx").Activate
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.Close
ActiveWindow.SmallScroll Down:=-18
Windows("Formeltabelle.xlsm").Activate
Windows("Makro.xlsx").Activate
ActiveWindow.Close
ActiveWorkbook.Save
ActiveWorkbook.RunAutoMacros Which:=xlAutoClose