Code erst weiter wenn Tabelle refresh
22.08.2022 00:58:28
Dennis
ich habe einen Code geschrieben, bei dem einfach ein paar Werte/Formeln kopiert werden. Klappt auch alles super. In der Datei sind 2 Reiter auf der jeweils eine dynamische Tabelle ist. Diese werden mit Hilfe des Makros und dem Befehl "ActiveWorkbook.RefreshAll" auch aktualisiert. Allerdings soll danach eine Tabelle kopiert werden. Und hier ist das Problem.
Die Aktualisierung dauert länger und der Code kopiert mir die leere Vorlagentabelle rüber. Gibt es einen Befehl oder Code um zu warten bis die Tabelle aktualisiert ist?
Ich hoffe ihr könnt mir helfen.
Sub Aktualisieren()
Set ta = Worksheets("Rohdaten")
Set tb = Worksheets("Daten")
Set tt = Worksheets("Temp")
Set tabc = Worksheets("Einteilung")
Set tk = Worksheets("Art")
Set tp = Worksheets("Paletten gemischt")
APP_PASSWORD = "Test"
Application.ScreenUpdating = False
Sheets("Temp").Unprotect Password:=APP_PASSWORD
Sheets("Art").Unprotect Password:=APP_PASSWORD
' Einteilung aktualisieren
xa = tabc.Cells(tabc.Rows.Count, 1).End(xlUp).Row
tabc.Range("A2:C" & xa).Copy
tk.Range("A2").PasteSpecial xlPasteValues
' Tabelle erweitern zwecks Auswertung
x = ta.Cells(ta.Rows.Count, 1).End(xlUp).Row
tb.ListObjects("Daten").Resize Range("$A$1:$C" & x)
'Rohdatendaten in Reiter Temp kopieren
tb.Range("A2:C" & x).Copy
tt.Range("A2").PasteSpecial xlPasteValues
' Formeln im Reiter Temp erweitern.
y = tt.Cells(tt.Rows.Count, 1).End(xlUp).Row
tt.Range("D2:E2").Copy
tt.Range("D3:E" & y).PasteSpecial xlPasteFormulas
n = tt.Cells(tt.Rows.Count, 9).End(xlUp).Row
tt.Range("J2:R2").Copy
tt.Range("J3:R" & n).PasteSpecial xlPasteFormulas
' Auswertungen aktualisieren
ActiveWorkbook.RefreshAll
' Paletten gemischt Formel anpassen
xa = ta.Cells(ta.Rows.Count, 1).End(xlUp).Row
tp.Range("A1:F" & xa).Copy
tp.Range("H1:H" & xa).PasteSpecial Paste:=xlPasteValues
xp = tp.Cells(tp.Rows.Count, 8).End(xlUp).Row
tp.Range("N3:N3").Copy
tp.Range("N4:N" & xp).PasteSpecial xlPasteFormulas
' Blattschutz wieder aktivieren
Sheets("Temp").Protect Password:=APP_PASSWORD, userInterfaceOnly:=True, DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Sheets("Art").Protect Password:=APP_PASSWORD, userInterfaceOnly:=True, DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Sheets("Rohdaten").Select
Application.ScreenUpdating = True
End Sub