VBA Code soll aus Access heraus aktualisiert

Sub kup_Q()
Dim Stelle As Integer
Dim NL As String
Dim txt As String
Dim pfad As String
Dim admsp As String
Dim myApp As New Excel.Application
Dim anzahl As Integer
Dim dbs As Database
Dim rst As Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT betriebsstätten.Niederlassung FROM betriebsstätten GROUP BY  _
_
betriebsstätten.Niederlassung")
rst.MoveFirst
myApp.DisplayAlerts = False
DoCmd.SetWarnings False
Do While Not rst.EOF
Stelle = rst.Fields(0)
'txt = rst.Fields(1)
Forms!Formular1!NL = Stelle
NL = Forms!Formular1!NL
DoCmd.RunMacro ("m_Q_kup")
pfad = "K:\Tiefbau2\Kundenpyramiden\Export Q"
Workbooks.Open FileName:=pfad & "\Kundenpyramide_STH_ProfessionalX_Vorlage.xlsm"
Workbooks.Open FileName:=pfad & "\Datenbasis Q_KUP akt.xlsx"
'Datenbasis akt. einfügen
Windows("Datenbasis Q_KUP akt.xlsx").Activate
Sheets("t_Q_KUP_aktPer").Select
Columns("A:S").Select
Selection.Copy
Windows("Kundenpyramide_STH_ProfessionalX_Vorlage.xlsm").Activate
Sheets("Database_akt").Select
Columns("A:S").Select
ActiveSheet.Paste
Sheets("Pivot_Analyser_akt").Select
Range("C8").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Windows("Datenbasis Q_KUP akt.xlsx").Activate
ActiveWindow.Close
'Datenbasis VPer einfügen
Workbooks.Open FileName:=pfad & "\Datenbasis Q_KUP V.xlsx"
Windows("Datenbasis Q_KUP V.xlsx").Activate
Sheets("t_Q_KUP_VPer").Select
Columns("A:S").Select
Selection.Copy
Windows("Kundenpyramide_STH_ProfessionalX_Vorlage.xlsm").Activate
Sheets("Database_V").Select
Columns("A:S").Select
ActiveSheet.Paste
Sheets("Pivot_Analyser_VJ").Select
Range("C8").Select
ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
Windows("Datenbasis Q_KUP V.xlsx").Activate
ActiveWindow.Close
Sheets("Kundenumsatzsegmente").Select
Range("E10").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Range("AG10").Select
ActiveSheet.PivotTables("PivotTable3").PivotCache.Refresh
ActiveWorkbook.SaveAs FileName:=pfad & "\" & NL & "KUP_Q.xls"
ActiveWorkbook.Close
Workbooks.Close
rst.MoveNext
Loop
DoCmd.SetWarnings True
MsgBox ("Fertig!")
End Sub

ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh