Bereich bis letzte beschriebene Zeile

[Enclave]

Hallo zusammen,

ich möchte einen Bereich Kopieren und in eine Mail einfügen,(dies am liebsten als Bild)

Bei dem Bereich möchte ich nur bis zur letzten zelle kopieren wo auch wirklich inhalt drin ist, aktuell wird er bis zu der Zelle Kopiert wo Formeln sind.

Code:

Sub mailsenden1()
  Dim sMailtext As String
 
 

  With Sheets("Mittagspausen verteilen")
    .Range("DK4:DO" & .Cells(Rows.Count, 63).End(xlUp).Row).Copy
End With
 
 
  With CreateObject("Outlook.Application").CreateItem(0)
      .BodyFormat = 2                               ' 2=HTML-Format, 3=Richtext
      .Subject = "Blockschichten für: " & Date + 1 ' Betreff
      Set .SendUsingAccount = .Session.Accounts.Item("Mail@mail.de")
      .To = "Mail@mail.de" & ";" & "Mail@mail.de"                               ' Empfänger
     
      .GetInspector                                 ' Signatur holen
      .htmlbody = Replace(sMailtext, vbLf, "<br>") & .htmlbody
      .Display
     
      With .GetInspector.WordEditor.Application.Selection
          .Start = Len(sMailtext):   .Paste
      End With
     
  End With
  Application.CutCopyMode = False
'
End Sub

[Kuwer]

Hallo,

z.B. so:

Code:

  With Sheets("Mittagspausen verteilen")
    .Range("DK4:DO" & .Columns(63).Find("*", .Cells(Rows.Count, 63), xlValues, , , xlPrevious).Row).Copy
  End With

Gruß Uwe

[Enclave]

Danke schon mal für deine Hilfe =)

da bekomm ich ein Laufzeitfehler 91
Objektvaribale oder With Blockvariable nicht festgelegt

LG Stefan

[Kuwer]

Hallo Stefan,

ich nicht.

Gruß Uwe

[Enclave]

Also so hab ich das jetzt:

ich finde keinen Fehler ^^

Code:

Sub mailsenden1()
  Dim sMailtext As String



  With Sheets("Mittagspausen verteilen")
    .Range("DK4:DO" & .Columns(63).Find("*", .Cells(Rows.Count, 63), xlValues, , , xlPrevious).Row).Copy
  End With


  With CreateObject("Outlook.Application").CreateItem(0)
      .BodyFormat = 2                               ' 2=HTML-Format, 3=Richtext
      .Subject = "Blockschichten für: " & Date + 1 ' Betreff
      Set .SendUsingAccount = .Session.Accounts.Item("Mail@mail.de")
      .To = "Mail@mail.de" & ";" & "Mail@mail.de"                               ' Empfänger
     
      .GetInspector                                 ' Signatur holen
      .htmlbody = Replace(sMailtext, vbLf, "<br>") & .htmlbody
      .Display
     
      With .GetInspector.WordEditor.Application.Selection
          .Start = Len(sMailtext):   .Paste
      End With
     
  End With
  Application.CutCopyMode = False
'
End Sub
Zitieren Suchen
Bearbeiten Antworten Melden Top

[Kuwer]

Hallo Stefan,

es dürfte doch kein Problem sein, bei einer Fehlermeldung auf Debuggen zu klicken, um zu sehen, was bemängelt wird.
Bei Deinem genannten Fehler gibt es vermutlich kein Sheet "Mittagspausen verteilen".
Einen anderen Fehler hab ich aber noch gefunden: Das Set muss raus.

Gruß Uwe

[Enclave]

Hey Uwe, auf debuggn hab ich natürlich geklickt dort wird diese Zeile makiert:

Code:

.Range("DK4:DO" & .Columns(63).Find("*", .Cells(Rows.Count, 63), xlValues, , , xlPrevious).Row).Copy

da ich ursprünglich diesen Code benutze:(der keine Fehler gibt) kann es nur einen Fehler ab .Columns geben(denke ich)

Code:

  With Sheets("Mittagspausen verteilen")

    .Range("DK4:DO" & .Cells(Rows.Count, 63).End(xlUp).Row).Copy

End With

[Kuwer]

Hallo Stefan,

vielleicht gibt es in der Spalte BK keine einzige Zelle mit einem Formelergebnis <>"" ?

Gruß Uwe

[Enclave]

in der Reihe DK:DO ist eine Tabelle also min der Spalte 6 ist der Tabellen kopf und somit immer DAten enthalten

[Kuwer]

Die Spalte 63 = BK, welche zur Ermittlung der letzten Zeile benutzt wird, stand in Deinem Code. Ich habe das nur übernommen.
Und weg.