Makro wird ungewollt in anderer Tabelle ausgeführt

Sub auto_open()
Menü_Erstellen
End Sub

Sub auto_close()
Menü_Löschen
End Sub

Sub Menü_Erstellen()
Dim MB As Object, MeinMenü As Object, Befehl As Object
Call Menü_Löschen
Set MB = CommandBars.ActiveMenuBar
Set MeinMenü = MB.Controls.Add(Type:=msoControlPopup, Temporary:=True)
MeinMenü.Caption = MenueName
Set Befehl = MeinMenü.Controls.Add(Type:=msoControlButton, ID:=1)
ThisWorkbook.Activate
With Befehl
.Caption = Befehl1
.OnAction = "Machwas1"
End With
End Sub

Sub Menü_Löschen()
On Error Resume Next
CommandBars.ActiveMenuBar.Controls(MenueName).Delete
End Sub

Sub Machwas1()
ThisWorkbook.Activate
Application.StatusBar = "Daten werden übertragen"
Übertrag
Application.StatusBar = ""
End Sub

Sub Übertrag()
Dim Konto As String
Dim Gkonto As String
Dim Betrag As String
Dim Tx1 As String
Dim Datum As String
ThisWorkbook.Activate
Application.ScreenUpdating = False
Datum = InputBox("Bitte Datum eingeben!")
Gkonto = InputBox("Bitte GKonto eingeben!")
Debug.Print Gkonto
Sheets("nachUmstellung").Select           'Zieldatei anwählen
Cells.Select
Selection.ClearContents                  'alle Zellen löschen
Sheets("vorUmstellung").Select            'Quelldatei anwählen
Application.Goto reference:="R2C1"  'Ausgangsposition in Quelldatei anwählen
Do While ActiveCell <> ""           'Schlaufe bis kein weiterer Datensatz vorhanden
Loop
Sheets("nachUmstellung").Select
Application.ScreenUpdating = True
End Sub