Hallo nochmal,

eine weitere Anfrage in Zusammenhang mit der Vorherigen:

In "Diese Arbeitsmappe" wird über Sub Workbook_open() der entsprechende Excelbereich in die Mail eingetragen.

Im Arbeitsblatt "Mika" befindet sich ein Button. Sobald ich diesen Button drücke, soll der gleiche Bereich markiert und in die zuvor geöffnete Mail ebenfalls eingetragen werden. Wie kriege ich es also hin, dass ich über zwei separate Programme auf die gleiche Mail zugreifen kann?

Diese Arbeitsmappe:

Option Explicit

Sub Workbook_Open()
' Sendet Mail mit integriertem Bereich als Bereich mit Signatur
  Dim WSh1 As Worksheet, WSh2 As Worksheet
  Dim sMailtext As String, sSignatur As String
  Dim sBer As String

  sBer = "A43:E54"                                ' Kopierbereich
 ' Set WSh1 = ThisWorkbook.Sheets("Mika")     ' Blatt mit den Maildaten
  Set WSh2 = ThisWorkbook.Sheets("Mika")     ' Datenblatt
  WSh2.Range(sBer).Copy                          ' Bereich kopieren

  With CreateObject("Outlook.Application").CreateItem(0)
      .BodyFormat = 2                            ' 2=HTML-Format
      .Subject = "Änderungen in der Mika " & Date & " " & Time   ' Betreff
      .To = "stefan.haderlein@gmx.de "
      .CC = "haderleinsusanne@gmail.com"
      sMailtext = "Hallo" & vbCrLf & vbCrLf & _
                  "Es haben sich Änderungen in der Mika ergeben." & vbCrLf & vbLf
      .GetInspector                              ' Signatur holen
      .htmlbody = Replace(sMailtext, vbLf, "<br>") & .htmlbody
      .Display

      With .GetInspector.WordEditor.Application.Selection
          .Start = Len(sMailtext)
          .Paste                                 ' Grafik in Mail einfügen
      End With

  End With

End Sub

Im Modul:

Option Explicit

Sub EMail()
' Sendet Mail mit integriertem Bereich als Bereich
  Dim WSh1 As Worksheet, WSh2 As Worksheet
  Dim sMailtext As String, sSignatur As String
  Dim sBer As String

  sBer = "A43:E54"                                ' Kopierbereich
 ' Set WSh1 = ThisWorkbook.Sheets("Mika")     ' Blatt mit den Maildaten
  Set WSh2 = ThisWorkbook.Sheets("Mika")     ' Datenblatt
  WSh2.Range(sBer).Copy                          ' Bereich kopieren

  With CreateObject("Outlook.Application").CreateItem(0)
      .BodyFormat = 2                            ' 2=HTML-Format
      .htmlbody = Replace(sMailtext, vbLf, "<br>") & .htmlbody
      .Display

      With .GetInspector.WordEditor.Application.Selection
          .Start = Len(sMailtext)
          .Paste                                 ' Grafik in Mail einfügen
      End With

  End With

End Sub