Vom Blatt nur bestimmte bereiche per Mail senden.

[Niko]

Hi Leute,
 
Hoffe alle hatten ein frohes Fest gehabt und sind noch guter Laune für das neue Jahr
 
Nach langen hin und her habe ich einen Code zusammengebastelt (danke an allen die mitgeholfen haben , da ich keine große leuchte von VBA bin habe ich das Prinzip Copy/Paste angewandt.
 
Versuche seit gestern in mein Code hinzuzufügen das es nur ein bestimmten bereich vom Blatt kopieren tut und als Datei in die mail, ohne großen Erfolg
 
Deshalb bitte ich nochmals um eure Hilfe bei mein vorhaben.
 
wie kann ich in diesen VBA Code den Bereich einfügen den ich kopieren möchte?
 
Möchte das der bereich B1:B35 und der Bereich L1:S35 gleichzeitig in das neue blatt kopiert, sehe anhangs Datei sowie VBA code. 

Ansonsten funktioniert der Code Super....nur den gewünschten bereich...grieg ich net hin.

Code:

Sub Excel_Sheet_via_Outlook_JanEZL()
ActiveWorkbook.ActiveSheet.Unprotect ("s0nne")
Dim GruppenName, KasseMonat As String
GruppenName = ThisWorkbook.Sheets("DPV1").Range("A3")
KasseMonat = Month(CDate(ThisWorkbook.Sheets("DPV1").Range("A2"))) & "/" & Year(CDate(ThisWorkbook.Sheets("DPV1").Range("A2")))
   Dim MyMessage As Object, MyOutApp As Object
   Dim SavePath As String
   Dim AWS As String
   SavePath = Environ("TEMP")
   Worksheets("DPV1").Copy
  ' Worksheets("DPV1").Range("B1:C35; L1:S35").Copy
   'Range("A3:AJ60").Select
   ' Selection.Copy
   ActiveSheet.UsedRange.Copy
   ActiveSheet.Cells().PasteSpecial xlPasteValues
 Application.Workbooks(Application.Workbooks.Count).SaveAs ThisWorkbook.Path & "\" & "Dienstplanung" & "_" & GruppenName & "_" & Format(Now, "ddmmyyyy__hhmm") & ".xlsx"
With Application.Workbooks(Workbooks.Count)
       AWS = .FullName
       .Close
   End With
   Set MyOutApp = CreateObject("Outlook.Application")
   Set MyMessage = MyOutApp.CreateItem(0)
   With MyMessage
       .To = "My.Kollegen@mail.de"
       .Subject = "Dienstplanung - Gruppe: " & GruppenName & " - Monat: " & KasseMonat & " - " & Date & "-" & Time
       .Attachments.Add AWS
       .Body = "Hallo Kollegen," & vbCrLf & vbCrLf & "Im Anhang dieser E-Mail befindet sich deine Dienstplanung in Form einer Excel Datei." & vbCrLf & "Die Datei wird automatisch generiert, bitte beim Aufmachen der Datei alle Vormeldungen zu akzeptieren/aktivieren oder/und auf Weiter zu Drücken." & vbCrLf & vbCrLf & "Zu öffnen mit dem MS Excel Programm oder einem Excel kompatiblen Programm." & vbCrLf & vbCrLf & vbCrLf & "Vielen Dank," & vbCrLf & GruppenName & ""
       .GetInspector
       .Display
       '.Send
       Kill AWS
   End With
   'MyOutApp.Quit
   Set MyOutApp = Nothing
   Set MyMessage = Nothing
   ActiveWorkbook.ActiveSheet.Protect ("s0nne")
End Sub

Datei:
  e-mail per sheet.xlsm (Größe: 38,33 KB / Downloads: 14)


Danke an alle

[RPP63]

Moin!
Ich habe mir die Datei nicht heruntergeladen.
Schließlich ist Deine Problembeschreibung imo schlüssig.

  Worksheets("DPV1").Copy

  With ActiveSheet
    With .UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
    Union(.Range("A:A"), .Range("C:K"), .Range("T:XFD")).Delete
    .Range("36:1048576").Delete
  End With

Gruß Ralf

[Niko]

Hi Ralf,
 
 
vielen, vielen Dank...es funktioniert...wie ein Silvesterfeuerwerk
 
Soweit ich es verstehen konnte hast du es durch das ausschlussverfahren bewerkstelligt.
 Läuft echt super….es reicht für mich vollkommen.

Würde der Code durch die Auswahl des zu kopierenden Bereiches schneller, als durch das ausschlussverfahren?
 
Wie auch immer, die Kollegen werden sich freuen ihren Arbeitsplan mit eine Mail zu bekommen.
Danke auch in deren Namen 
 
Wünsche noch ein guten Rutsch ins Neue Jahr mit viel Freude, Liebe und Gesundheit .
 

Ps. Fischen zu lernen macht einen geistig satter und glücklicher.


Danke,
Niko