Hallo Way,

hab es abgeändert aber nicht getestet

Sub Makro7()
   '
   ' Makro7 Makro
   Dim Zeile As Integer
   Dim Spalte As Integer
   Dim ZelleK As Integer
   Const Auswahl As String
   Dim Wert As String
      
   Auswahl = "x"
   Zeile = 2
   Spalte = 1
   'ZelleK = 2
   ActiveWorkbook.Save
   Workbooks("Registrierung.xlsm").Worksheets("Liste").Activate

   Wert = Workbooks("Registrierung.xlsm").Worksheets("Trackingliste").Cells(Zeile, Spalte).Value
   If Wert = Auswahl Then
      Range("B1:Q1").Select
      Range("B1:Q1", "B5:Q5").Select
      Range("B5").Activate
      Selection.Copy
      Range("A1").Select
      ActiveSheet.Cells(Rows.Count, ActiveCell.Column).Select
      If IsEmpty(ActiveCell) Then
         ActiveCell.End(xlUp).Select
         aH = ActiveCell.Row
         a = aH + 1
         b = ActiveCell.Column
      End If
   End If

   Workbooks.Open Filename:="P:\Neu\Email.xls"
   Sheets("Liste").Select
   Range("A1").Select
   ActiveSheet.Paste
   Application.CutCopyMode = False
   ActiveWorkbook.Save
   ActiveWindow.Close
   With Selection.Interior
      .Pattern = xlNone
      '.TintAndShade = 0
      '.PatternTintAndShade = 0
   End With
   ActiveWorkbook.Save
      
   Dim outApp As Object
   Set outApp = CreateObject("Outlook.Application")
   Set outmail = outApp.CreateItem(0)
   With outmail
      'Empfänger
      .To = "xx@info.com"
      .CC = "yy@info.com"
      ' .BCC = ""
      'Betreff
      .Subject = "Eingang"
      'Nachricht
      .Body = "Hallo Frau XX," & Chr(13) & _
              "anbei ein eingegangener Fall ..." & Chr(13) & _
              "Viele Grüße" & Chr(13) & Chr(13)
      'Lesebestätigung aus
      .ReadReceiptRequested = True
      'Dateianhang
      .Attachments.Add "P:\Neu\Email.xls"
      .Display
   End With
   Set outApp = Nothing
End Sub

Gruß Detlev