Gefilterte Excel Daten über VBA als Mail versenden.

[FNCAOS]

Hallo zusammen, 
das Homeoffice macht erfinderisch bzw. muss man versuchen effektiv arbeiten zu können um nebenbei noch Homescholling zu machen.
Ich habe eine sehr große Excel Datei, die ich an verschiedene Leute "D" senden muss. Die Daten der anderen darf der Empfänger nicht sehen. Somit muss ich zuvor die Daten für den jeweiligen Partner filtern. 
Ich habe leider absolut keine Ahnung von VBA Codes. Habe schon diverse Videos geschaut und Beiträge gelesen, aber ich komme nicht weiter.
Ich möchte gerne, das ich die gefilterten Daten, per Knopfdruck an die Mail Adresse aus "E" verschicken kann.
Konnte ich mich verständlich ausdrücken?
Mein Sohn dankt Euch für Eure Hilfe ...dann kann der Papa nämlich seine Mathe Aufgaben machen...
Vielen Dank für Eure Unterstützung.
VG
CAOS

[schauan]

Hallöchen,

auch wenn VBA nicht Dein Ding ist versuche ich es trotzdem erst mal nur mit eienm Tipp. Schaue mal bei uns in die Suche. Dort gibt es einige Lösungen wie man per Makro Dateien in eine Email packt und versendet. Im Prinzip musst Du Deine Tabelle filtern, das gefilterte Ergebnis z.B. als pdf speichern, versenden und die pdf kann dann sicher wieder gelöscht werden.

[FNCAOS]

Hallo, vielen Dank vorab für Deine Antwort.
Ich hatte schon gesucht und auch gefunden...nur sollte das Tabellenblatt auch als Excel und eben nicht als PDF verschickt werden. Das hatte ich sogar hinbekommen. Auch wenn es sehr unkomfortabel war, da ich die Empfänger Mail nach wie vor eingeben musste, den Betreff auch noch händisch pflegen musste und es eben eine PDF war. 
Ich kann eben den Code nicht allein schreiben. Vielleicht könnt ihr mir weiter helfen.
Wäre klasse.
Vielen Dank!

[schauan]

Hallöchen,

In Deinem Muster hast Du 4 Namen. Du willst zu jedem Namen die entsprechende Zeile nebst Überschriften senden?

Ich habe hier mal mit dem Makrorekorder was aufgezeichnet. Das erzeugt Dir erst mal in C:\Temp eine Exceldatei mit den Inhalten der gefilterten Zeile nebst Überschriften. Wäre das ok? Den Code kann man natürlich noch optimieren
Dann käme als nächster Step das Erzeugen der E-Mail. Die E-Mail-Adresse steht dann ja immer in E3. Was ist aber der Betreff? Soll es auch einen Mailtext geben? AM Ende müsstest Du nur noch "Senden" drücken ...

Code:

Sub Makro1()
'
' Makro1 Makro
'

'
    Rows("2:8").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("A:O").Select
    Columns("A:O").EntireColumn.AutoFit
    Range("A2").Select
    Sheets("Tabelle1").Select
    Application.CutCopyMode = False
    Sheets("Tabelle1").Move
    ChDir "C:\Temp"
    ActiveWorkbook.SaveAs Filename:="C:\Temp\MappeTest.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
End Sub

[volti]

Hallo CAOS,

falls Du die Auswertung der Daten nicht mit Anhang als Excelsheet versenden möchtest, sondern die Auswertung direkt in eine Mail einbetten möchtest, kannst Du Dir nachfolgendes Beispiel mal anschauen.
Bei Gefallen kannst Du es entsprechend anpassen,  ausbauen und verwenden.

Code:

Option Explicit

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Mail_Senden()
' Sendet Mail mit integriertem Bereich als Bereich mit Signatur
  Dim WSh As Worksheet, sBer As String
  Dim sMailtext As String
  Dim sEmpfaenger As String
  Dim iEinf As Integer, iZeile As Long, iBeginn As Long, iEnde As Long

  Set WSh = ThisWorkbook.ActiveSheet                 ' Blatt mit Maildaten und Daten
  iZeile = WSh.Cells(Rows.Count, "D").End(xlUp).Row  ' Letzte Zeile in Spalte

  For iZeile = 4 To iZeile                           ' erste relevante Zeile ermitteln
      If WSh.Rows(iZeile).Hidden = False Then
         If InStr(sEmpfaenger, WSh.Cells(iZeile, "E").Value & ";") = 0 Then
            sEmpfaenger = sEmpfaenger & WSh.Cells(iZeile, "E").Value & ";"
         End If
         If iBeginn = 0 Then iBeginn = iZeile
         iEnde = iZeile
      End If
  Next iZeile
  If sEmpfaenger = "" Then Exit Sub                  ' Kein Empfänger =>raus
  sEmpfaenger = Left$(sEmpfaenger, Len(sEmpfaenger) - 1)

  sBer = "F2:O3,F" & iBeginn & ":O" & iEnde          ' Kopierbereich setzen

  With CreateObject("Outlook.Application").CreateItem(0)
      .BodyFormat = 2                                ' 2=HTML-Format
      .Subject = "Auswertung der Woche " & WSh.Name  ' Betreff
      .To = sEmpfaenger                              ' Empfänger

      sMailtext = "Anbei Ihre Daten:¶¶<b>Partner:</b> " & vbTab _
                & WSh.Cells(iBeginn, "D").Value & "¶<b>Straße:</b> " _
                & WSh.Cells(iBeginn, "C").Value & "¶<b>Ort:</b> " _
                & WSh.Cells(iBeginn, "B").Value & "¶¶"

      iEinf = Len(sMailtext) - 22                    ' Grafik Einfügestelle
      sMailtext = "<body style='font-family:Arial; font-size:10pt;color:#000000'>" _
      & sMailtext & "</body>"                        ' Schrift formatieren
      .Getinspector:                                 ' Signatur holen
      .htmlbody = Replace(sMailtext, "¶", "<br>") & .htmlbody
      .Display                                       ' Mail anzeigen

      On Error Resume Next
      Do
         Err = 0: Sleep 100
         WSh.Range(sBer).Copy                        ' Bereich kopieren
         If Err = 0 Then Exit Do
      Loop

      With .Getinspector.WordEditor.Application.Selection
          .Start = iEinf: .Paste                     ' Bereich in Mail einfügen
      End With
Rem   .Send                                          ' Mail absenden

  End With

End Sub

_________
viele Grüße
Karl-Heinz

[FNCAOS]

Hallo, 
Vielen Dank und Sorry da sich gestern nicht mehr geantwortet habe.
Also, meine "Wusch" Vorstellung war, das ich nachdem ich die Daten gefiltert habe, auf eine Schaltfläche drücke, und automatisch eine Mail erzeugt wird (Adresse steht immer in Spalte E ) mit der (gefilterten) Excel datei im Anhang.
Wenn dann noch im Betreff stehen würde "Bestand KW) wäre das ein toller Zusatz. Muss aber nicht.
"Mehr" bräuchte ich nicht.
Ich finde es klasse, das ihr Euch so für Fremde Leute engagiert.
Vielen dank!

---

Hallo Karl Heinz, auch Dir vielen Dank für Deine Antwort.
Ich würde schon gerne die (gefilterten) Daten als Excel Anhang verschicken. Wie zuvor beschrieben bin ich leider nicht der VBA Held. Hatte mir aber vorgestellt, das es Möglich sein müsste, über eine Schaltfläche per Klick die gefilterten Daten als Excel Anhang an die in Spalte E stehende EMail versenden zu können.
Mir scheint, als ob Du das locker kannst
Auch hier noch einmal: Ich finde es toll das ihr Euch so für Fremd Leute engagiert und helft. Klasse. 
Vielen Dank!

[schauan]

Hallöchen,

komplettiert, überarbeitet und kommentiert könnte das dann so aussehen. Ich habe hier aber keinen Text und keine Signatur in der EMail, das wolltest Du nicht. Die Endzeilennummer - hier 8 - könnte man übrigens auch automatisieren ...

Code:

Sub Makro2()
    'gefilterten Bereich kopieren - ggf. Zeilennummer 8 anpassen!
    Rows("2:8").Copy
    'neues Blatt einfuegen
    Sheets.Add After:=ActiveSheet
    'Werte in A2 einfuegen
    With Range("A2")
      .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    'Ende Werte in A2 einfuegen
    End With
    'Kopiermarkierung deaktivieren
    Application.CutCopyMode = False
    'Spaltenbreite setzen
    Columns("A:O").EntireColumn.AutoFit
    'Blatt in neue Datei verschieben
    ActiveSheet.Move
    'Verzeichnis wechseln (muss nicht sein)
    ChDir "C:\Temp"
    'Neue Datei speichern unter
    ActiveWorkbook.SaveAs Filename:="C:\Temp\Bestand_KW.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    'Neue Datei schliessen
    ActiveWindow.Close
    'EMail erzeugen
    With CreateObject("Outlook.Application").CreateItem(0)
        .Subject = "Bestand KW"                        ' Betreff
        .To = Range("E3").Value                        ' Empfänger
        .Display                                      ' Mail anzeigen
        .Attachments.Add "C:\Temp\Bestand_KW.xlsx"
    'Ende EMail erzeugen
    End With
    '.send
    'temporaere Datei loeschen
    Kill "C:\Temp\MappeTest.xlsx"
End Sub

[volti]

Hallo Andre,

mir sind noch folgende Dinge aufgefallen:

C:\Temp läuft ins Leere (bei mir)
Ich schlage daher vor, das wirkliche TEMP-Verzeichnis zu nutzen: sPfad = Environ$("Temp") & "\"
Das ist auf jeden Fall immer und überall vorhanden

.To = Range("E3").Value
Der erste Empfänger beginnt in E4. Aber man müsste ohnehin den Empfänger aus der neu erstellten Datei nehmen.
Wenn der Empfänger aus der Originaldatei genommen wird, wird immer die gleiche eMail-Adresse genommen, auch wenn ich andere Leute gefiltert habe.

Kill "C:\Temp\MappeTest.xlsx"
Es wird eine andere Datei gekillt. Nicht die erstellte BestandKW.
Da die nicht vorhanden ist, wird ein Fehler erzeugt.

viele Grüße
Karl-Heinz

[schauan]

Hi Karl-Heinz,

danke für die Korrekturen.