Clever-Excel-Forum

Hallo Forum-Gemeinde,

H Ü L F E  :17:

Aus einer Excel-Mappe möchte ich einzelne zuvor definierte Tabellenblätter per E-Mail versenden. Dies habe ich mir so weit zusammengebastelt:

Sub GSV_Protokolle_senden_senden()
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Dim arrTabs()
ReDim arrTabs(1 To 3)
    arrTabs(1) = "IB GSV"
    arrTabs(2) = "Einw. GSV"
    arrTabs(3) = "Abn. GSV"
    Worksheets(arrTabs).Copy
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
strPfad = "H:\"
ActiveWorkbook.SaveAs strPfad & "GSV Protokolle" & " # " & ActiveSheet.Range("V3") & ".xls"
strDatei = ActiveWorkbook.FullName
With Mail
'.To = ""
'.CC = ""
.Subject = "" 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With
Workbooks(Dir(strDatei)).Close
Kill (strDatei)
Mail.Display
End Sub

Was nun noch fehlt: Ich möchte gerne in der Zieldatei nur Werte, keine Formeln stehen haben UND ich würde gerne nur einen ausgewählten Druckbereich in der Zieldatei haben wollen.
Kann mir hier jemand behilflich sein?

Vielen Dank im Voraus.

Hallöchen,

sollte alles relativ einfach gehen, ggf. mit Aufzeichnen.

Wenn Du die Mappe oder Tabelle gespeichert hast, tust Du einfach alles kopieren und mit Inhalte Einfügen - Werte die Formeln entsprechend ersetzen.

Beim Druckbereich wäre zu überlegen, ob der auch für Dich passt. Dann kannst Du ihn gleich im Original festlegen und er bleibt dann so. Ansonsten auch mal aufzeichnen und das Makro dann aus dem "Sendemakro" heraus aufrufen.

Das bringt mich irgendwie noch nicht weiter...
Hat jemand einen Vorschlag, wie man die Punkte einbinden kann?

Hallöchen,

hast Du denn schon was aufgezeichnet? Wenn Du das postest, kann ich es Dir einbauen.

Dies wäre im Prinzip die Aufzeichnung... hier wurde statt der Auswahl des Druckbereiches die überflüssigen Spalten gelöscht.



Kann man diese Zeile aus dem oben genannten Code erweitern, dass nur ein festgelegter Bereich kopiert wird (.Range, o.ä)?

Hallöchen,

Zitat:Kann man diese Zeile aus dem oben genannten Code erweitern, dass nur ein festgelegter Bereich kopiert wird (.Range, o.ä)?

Ich hatte ja gedacht, dass Du das auch beim Ersetzen der Formeln so machst. Nun hast Du aber alle Zellen kopiert und eingefügt ...

Im konkreten Fall
Worksheets(arrTabs).Copy
geht es aber darum, dass die Blätter in eine neue Datei kopiert werden.
Wenn Du nur Bereiche kopieren willst, müsstest Du die Blätter und die Datei, wo die Daten hin sollen, vorher anlegen.
im Prinzip

WorkBooks.Add
ActiveWorkBook.SaveAs "LW:\Pfad\" & "neueMappe.xls"
Sheets.Add
ActiveSheet.Name = "neuesBlatt"
Range("A1:B2").Value = Workbooks("alteMappe").Sheets("altesBlatt").Range("A1:B2").Value

Oder
Du kopierst die Blätter und, wie in Deinem aufgezeichneten Code, löschst Du anschließend nicht benötigte Daten / Spalten / Zeilen / Zellen ...

In Deinem aufgezeichneten Code hast Du einige Spalten gelöscht. Das hab ich jetzt mal außen vor gelassen, stand ja noch nicht zur Debatte.
Hier mal auf Basis der Aufzeichnung ein zusammengefasster Code.


Eingefügt in Deinen Code und noch das Select entfernt sieht das dann so aus:

Sub GSV_Protokolle_senden_senden()
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Dim arrTabs()
ReDim arrTabs(1 To 3)
    arrTabs(1) = "IB GSV"
    arrTabs(2) = "Einw. GSV"
    arrTabs(3) = "Abn. GSV"
    Worksheets(arrTabs).Copy
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
strPfad = "H:\"
ActiveWorkbook.SaveAs strPfad & "GSV Protokolle" & " # " & ActiveSheet.Range("V3") & ".xls"
With Sheets("IB GSV")
.Cells.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
With Sheets("Abn. GSV")
.Cells.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
With Sheets("Einw. GSV")
.Cells.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
ActiveWorkbook.Save
strDatei = ActiveWorkbook.FullName
With Mail
'.To = ""
'.CC = ""
.Subject = "" 'Betreff
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With
Workbooks(Dir(strDatei)).Close
Kill (strDatei)
Mail.Display
End Sub

Cells = Cells.Value

reicht doch! Nicht immer durch die Gegend kopieren.

Das hat geholfen. Prima, danke sehr  :19: