Sub mysClick()
Dim Quelle As Worksheet
Dim Ziel As Worksheet
Application.ScreenUpdating = False
Set Quelle = ThisWorkbook.Worksheets("Tabelle1")
Set Ziel = Workbooks("Mappe2.xlsx").Worksheets("DB")
Ziel.Range("A" & Ziel.Cells(Ziel.Rows.Count, 1).End(xlUp).Row + 1).Value = Quelle.Range("D4").Value
Ziel.Range("B" & Ziel.Cells(Ziel.Rows.Count, 1).End(xlUp).Row).Value = Quelle.Range("D6").Value
Ziel.Range("EI" & Ziel.Cells(Ziel.Rows.Count, 1).End(xlUp).Row).Value = Quelle.Range("B87").Value
ActiveSheet.Copy after:=Workbooks("Mappe2.xlsx").Sheets(Workbooks("Mappe2.xlsx").Sheets.Count)
With ActiveSheet
On Error Resume Next
.Name = .Range("H4")
End With
Application.ScreenUpdating = True
End Sub