Hallo zusammen,
ich habe folgenden Code geschriebne. Das Makro läuft allerdings sehr langsam, auch wenn man nur 1 Datei auswählt aus der die Update Zahlen kommen.
Hat jemand eine Vermutung woran das liegen könnte? bin für jeden Tipp dankbar!
Danke schon mal.
Code
Sub UpdateDateienEinspielen()
Application.ScreenUpdating = False
Dim wksDiesesSheet As Worksheet
Set wksDiesesSheet = ActiveSheet
wksDiesesSheet.Outline.ShowLevels RowLevels:=2
'Überschreiben der alten Werte durch neuen
Range("AG5:AK1100").Select
Selection.Copy
Range("AA5").Select
ActiveSheet.Paste
Dim wksQuelle As Object
Dim lastrow As Long
Dim ID As Variant
Dim Stufen As Range
Dim NeueZahlen As Range
Dim Kommentare As Range
'Auswählen der Update Dateien
'Defines the variable as a variant data type
Dim X As Variant
'Opens the dialog
SpeicherPfad = ThisWorkbook.Path & "\"
ChDir SpeicherPfad
X = Application.GetOpenFilename _
("Excel-Datei (*.xls), *.xls, Add-in Files (*.xls), *.xls", 2, _
"Open My Files", , True)
'Loops through every file that is selected and opens each one
For Y = 1 To UBound(X)
Workbooks.Open X(Y)
Set wksQuelle = GetObject(X(Y))
lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 6 To lastrow 'gehe durch alle befüllten Zeilen in der Update datei
wksQuelle.Activate 'Aktiviere Update Datei
If Cells(i, 6).Value = "3" Then
ID = Cells(i, 3).Value
Set Stufen = Range(Cells(i, 22), Cells(i, 26)) 'kopiere Stufen
Set NeueZahlen = Range(Cells(i, 41), Cells(i, 44)) 'kopiere Neue Zahlen
Set Kommentare = Range(Cells(i, 46), Cells(i, 47)) 'kopiere Kommentare
wksDiesesSheet.Activate 'gehe in Master Sheet
Columns("B:B").Select
Selection.Find(What:=ID, After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Select
Zeile_Master = Selection.Row
Stufen.Copy Range(Cells(Zeile_Master, 15), Cells(Zeile_Master, 19)) 'fuege Stufen ein
NeueZahlen.Copy Range(Cells(Zeile_Master, 34), Cells(Zeile_Master, 37)) 'füge New Forecast ein
Kommentare.Copy Range(Cells(Zeile_Master, 39), Cells(Zeile_Master, 40)) 'fuege Kommentare ein
End If
Next i
wksQuelle.Close
Next Y
End Sub