ungetestet

Option Explicit

Sub Test()
  Dim strName As String
  With ThisWorkbook.Worksheets("Basisreiter")
    strName = Trim$(.Range("A6").Value)
    Call .Copy()
  End With
  With ActiveWorkbook
    .Worksheets(1).Name = strName
    Call .SaveAs(Environ$("USERPROFILE") & "\Desktop\" & strName, xlOpenXMLWorkbook) 'save as XLSX
    Call .Close()
  End With
End Sub