Kopieren in anderes Tabellenblatt flasche Zeile
12.03.2019 14:12:20
Teufel
nachdem mir Herbers Excel Forum schon bei so manchen Problemchen geholfen hat, hoffe ich, dass mir die Community auch bei meinem Problem nun helfen kann.
Die Tabelle ist in mehrere Bereiche geteilt. Ein "hochziehen" der Einträge durch die einzelnen Bereiche inkl. eMailfunktion funktioniert soweit.
Nun kommt aber das ABER:
Wenn der letzte Bereich der Tabelle erreicht ist, soll die Zeile in der sich die Aktive Zelle befindet von Spalte 2 bis 32 kopiert werden und in Tabellenblatt 3 eingefügt werden. Folgende Kopiervorgänge sollen immer in die nächste freie Zeile in Tabelle3 eingefügt werden.
Doch leider wird immer in einer anderen Zeile, also nicht Zeile 1, dann 2, eingefügt, sondern in Zeile 79. Nun ist Zeile 79 aber die erste freie Zeile in Tabelle1. Warum wird nun beim kopieren in Zeile 79 in Tabelle3 geschrieben und nicht in Zeile 1.
Hier mein Code:
Private Sub fertig_Click()
On Error GoTo errhandler
' Ausleiten des Datensatzes in das Tabellenblatt Archiv
Dim vorprüfZeile As Long
vorprüfZeile = ActiveCell.Row
' Zeile mit Motor kopieren
Tabelle1.Range(Cells(vorprüfZeile, 2), Cells(vorprüfZeile, 32)).Copy Destination:=Tabelle2. _
_
Cells(Cells(Rows.Count, 6).End(xlUp).Row + 1, 2)
' Einfügen der Daten in Tabellenblatt Archiv
'Tabelle2.Cells(Cells(Rows.Count, 6).End(xlUp).Row + 1, 2).PasteSpecial Paste:= _
xlPasteValues
'Tabelle2.Cells(Cells(Rows.Count, 6).End(xlUp).Row + 1, 2).PasteSpecial Paste:= _
xlPasteFormats
' Datensatzzeile löschen und neue Zeile unten im Bereich Aufbau einfügen
Tabelle1.Range(Cells(vorprüfZeile, 2), Cells(vorprüfZeile, 32)).Delete
Tabelle1.Range(Cells(22, 2), Cells(22, 32)).Insert
' Zwischenablage löschen
Application.CutCopyMode = False
' eMail Funktion für Vorhalt
' Set Outlook application object
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
' Create eMail as Object
Dim ObjEmail As Object
Set ObjEmail = objOutlook.CreateItem(0)
With ObjEmail
' Empfänger
.To = Application.WorksheetFunction.VLookup(Cells(ActiveCell.Row, 22), Worksheets(" _
Tabelle3").Range("A:J"), 3, False)
'.cc = Application.WorksheetFunction.VLookup(Cells(ActiveCell.Row, 20), Worksheets(" _
tabelle3").Range("A2:J130"), 3, False)
' Betreff
.Subject = "Statusbericht"
' eMail-Inhalt
.HTMLbody = "eMail Inhalt Vertraulich"
ObjEmail.display
End With
Set ObjEmail = Nothing: Set objOutlook = Nothing
errhandler:
End Sub
Grüße