Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 15:03:35
Unterschiedliche Dateien miteinander abgleichen lassen
25.04.2024 14:05:48
Makro in aktueller Zelle ausführen mit Doppelklick
25.04.2024 12:56:25
Werte von Kunden und Artikel stehen untereinander
25.04.2024 12:55:42
Funktionsparameter auslesen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1760to1764
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1760to1764
1760to1764
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bereich ermitteln und kopieren

Bereich ermitteln und kopieren
06.06.2020 19:17:20
Stefan
Seid gegrüßt!
Ich bitte um Hilfestellung. Und zwar möchte ich einen bestimmten Bereich kopieren.
Alles in den Spalten A:E. Dazu möchte ich die letzte verwendete Zelle in diesem Bereich ermitteln und alles bis dahin kopieren. Meine aktuelle Formel lautet:
Sheets("AE").Range("A1:E42").Copy
Dies ist nur ein Dummy um zu schauen ob der Rest der Codierung passt. Funktioniert Super!.
Kopiert werden soll alles von A1:E variabel. Es kann auch sein dass am Ende in der Zelle B98 etwas steht, dafür nichts in A, C, D und E. Es soll dann trotzdem der Bereich A1:E98 kopiert werden.
Bitte Helft mir :)
Vielen Dank und LG
Stefan

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bereich ermitteln und kopieren
06.06.2020 19:48:56
Werner
Hallo,
zum Beispiel so: 
Sub Schaltfläche1_Klicken()
Dim loLetzte As Long, loLetzte1 As Long
With Worksheets("AE")
For i = 1 To 5
loLetzte = .Cells(.Rows.Count, i).End(xlUp).Row
If loLetzte > loLetzte1 Then loLetzte1 = loLetzte
Next i
.Range("A1:E" & loLetzte1).Copy
'hier dann wohin kopiert werden soll
End With
End Sub
Gruß Werner
Anzeige
AW: Bereich ermitteln und kopieren
06.06.2020 20:40:31
Stefan
Vielen Dank für die beiden Antworten.
Leider weiß ich nicht so recht, wie ich dies in meinen Code einfügen muss.
Ich kann ja mal den kompletten hier reinsetzen. Wie gesagt, er funktioniert super, nur das mit dem kopieren noch nicht wie ich es möchte.
Werner, kannst du mir sagen wie ich meinen Code abändern muss?
Private Sub Absenden_Click()
'EmailManuellAbsenden
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)
With newEmail
.To = Sheets("Allgemein").Range("G24")
.CC = Sheets("Allgemein").Range("G25")
.Body = "Hallo " & Sheets("Vorlagen").Range("A53").Value & vbLf & vbLf & "wir haben  _
einen neuen Auftrag. Die Bestellung findest du anbei."
.display
Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor
Sheets("AE").Range("A1:E42").Copy
pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)
.display
Set pageEditor = Nothing
Set xInspect = Nothing
Application.CutCopyMode = False
End With
Set newEmail = Nothing
Set outlook = Nothing
End Sub

Vielen Dank!
Anzeige
AW: Bereich ermitteln und kopieren
06.06.2020 21:55:47
ralf_b
versuch mal so. ungetestet
Private Sub Absenden_Click()
'EmailManuellAbsenden
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Dim loLetzte As Long, loLetzte1 As Long
Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)
With newEmail
.To = Sheets("Allgemein").Range("G24")
.CC = Sheets("Allgemein").Range("G25")
.Body = "Hallo " & _
Sheets("Vorlagen").Range("A53").Value & vbLf & vbLf & _
"wir haben einen neuen Auftrag. Die Bestellung findest du anbei."
.display
Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor
'Sheets("AE").Range("A1:E42").Copy
With Worksheets("AE")
For i = 1 To 5
loLetzte = .Cells(.Rows.Count, i).End(xlUp).Row
If loLetzte > loLetzte1 Then loLetzte1 = loLetzte
Next i
.Range("A1:E" & loLetzte1).Copy
'hier dann wohin kopiert werden soll
pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)
.display
End With
Set pageEditor = Nothing
Set xInspect = Nothing
Application.CutCopyMode = False
End With
Set newEmail = Nothing
Set outlook = Nothing
End Sub

Anzeige
AW: Bereich ermitteln und kopieren
08.06.2020 10:41:46
Stefan
Hi Ralf, so klappt es leider nicht. Das war auch zuerst meine Vermutung.
Ich komm einfach nicht drauf, also wenn einer vlt noch eine andere Lösung parat würde ich mir sehr freuen. LG
AW: Bereich ermitteln und kopieren
08.06.2020 10:47:01
Stefan
Habs jetzt raus! Vielen Dank für eure Hilfe! Problem gelöst :)
Für alle die es interessiert, so sieht es jetzt aus:
Private Sub Absenden_Click()
'EmailManuellAbsenden
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Dim loLetzte As Long, loLetzte1 As Long
Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)
With newEmail
.To = Sheets("Allgemein").Range("G24")
.CC = Sheets("Allgemein").Range("G25")
.Body = "Hallo " & Sheets("Vorlagen").Range("A54").Value & vbLf & vbLf & "wir haben  _
einen neuen Auftrag. Die Bestellung findest du anbei."
.display
Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor
With Sheets("AE")
For i = 1 To 6
loLetzte = .Cells(.Rows.Count, i).End(xlUp).Row
If loLetzte > loLetzte1 Then loLetzte1 = loLetzte
Next i
.Range("A1:E" & loLetzte1).Copy
End With
pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)
.display
Set pageEditor = Nothing
Set xInspect = Nothing
Application.CutCopyMode = False
End With
Set newEmail = Nothing
Set outlook = Nothing
End Sub

Anzeige
Gerne u. Danke für die Rückmeldung. o.w.T.
08.06.2020 19:42:33
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige