Hallo liebe Community,

vll. könnt ihr mir weiterhelfen, ich möchte dass durch einen Klick auf einen Button alle eingegeben Daten in die gleiche Zeile gespeichert werden.

Irgendetwas mache ich falsch. Ich möchte auch den Fehler verhindern, wenn der vorherige User Daten ausgelassen hat, dass ausschließlich die neue Zeile befüllt wird und nichts in den Zeilen verrutscht.

Hierzu mein code.

Private Sub BeinaheunfallVerteilen_Click()

Worksheets("Beinaheunfall").Range("E3").Value = Me.ComboBox1.Value              'Werk
Worksheets("Beinaheunfall").Range("A5") = TextBoxBeinaheunfallVorname           'Vorname
Worksheets("Beinaheunfall").Range("E5") = TextBoxBeinaheunfallNachname          'Nachname
Worksheets("Beinaheunfall").Range("A7") = TextBoxBeinaheunfallMaschine          'Maschine
Worksheets("Beinaheunfall").Range("E7") = TextBoxBeinaheunfallAbteilung         'Abteilung
Worksheets("Beinaheunfall").Range("A10") = TextBoxBeinaheunfallUnfallhergang    'Unfallhergang

Worksheets("Beinaheunfälle").Cells(Cells(Rows.Count, "A").End(xlUp).Row + 1, "A").Value = TextBoxBeinaheUnfallDatum          'erste freie Zelle in Spalte A "Datum"
Worksheets("Beinaheunfälle").Cells(Cells(Rows.Count, "B").End(xlUp).Row + 1, "B").Value = ComboBox1                          'erste freie Zelle in Spalte B "Werk"
Worksheets("Beinaheunfälle").Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, "C").Value = TextBoxBeinaheunfallVorname        'erste freie Zelle in Spalte C "Vorname"
Worksheets("Beinaheunfälle").Cells(Cells(Rows.Count, "D").End(xlUp).Row + 1, "D").Value = TextBoxBeinaheunfallNachname       'erste freie Zelle in Spalte D "Nachname"
Worksheets("Beinaheunfälle").Cells(Cells(Rows.Count, "E").End(xlUp).Row + 1, "E").Value = TextBoxBeinaheunfallMaschine       'erste freie Zelle in Spalte E "Maschine"
Worksheets("Beinaheunfälle").Cells(Cells(Rows.Count, "F").End(xlUp).Row + 1, "F").Value = TextBoxBeinaheunfallAbteilung      'erste freie Zelle in Spalte F "Abteilung"
Worksheets("Beinaheunfälle").Cells(Cells(Rows.Count, "G").End(xlUp).Row + 1, "G").Value = TextBoxBeinaheunfallUnfallhergang  'erste freie Zelle in Spalte G "Unfallhergang"


ChDir "C:\Temp\"
Worksheets("Beinaheunfall").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Temp\Beinaheunfall.pdf"


 ' ############################################################
 ' Die Variablen für Empfänger und Anhang sind richtig zu belegen
 ' ############################################################
 Dim sText As String, sEmpfang As String, sBetrifft As String
 Dim session As Object, db As Object, doc As Object, rtobject As Object
 Dim rtitem As Object, sKopie As String
 Dim AttachMe As Object, DerAnhang As Object
 Dim user As String, server As String
 Dim mailfile As String, sBlindKopie As String
 Dim vAn As Variant, vCopy As Variant
 Dim vBlind As Variant, sAnhang As String
 On Error GoTo Fehler
 sText = "Diese eMail wurde automatisch generiert und dient der Informationspflicht des SGA-Managementbeauftragten an die Zentrale." & vbCrLf & "Bei Fragen wenden Sie sich bitte an den Absender."
 sText = Replace(sText, vbCrLf, Chr(10)) ' Zeilenumbrüche ändern
 sEmpfang = "christoph.friedrich@scherdel.com"  ' Einträge durch " ; " getrennt
 sBetrifft = "Beinaheunfall" ' die Betreffzeile
 sKopie = "" ' Einträge durch " ; " getrennt
 sBlindKopie = "" ' Einträge durch " ; " getrennt
 vAn = Split(sEmpfang, " ; ") ' Empfänger Array
 sAnhang = "C:\Temp\Beinaheunfall.pdf" ' Muss natürlich richtig gesetzt werden
 If Len(sKopie) > 0 Then vCopy = Split(sKopie, " ; ") 'cc Array
 If Len(sBlindKopie) > 0 Then vBlind = Split(sBlindKopie, " ; ")  'bcc Array
 Set session = CreateObject("notes.notessession") ' Notes muss gestartet sein
 user = session.UserName
 server = session.GetEnvironmentString("MailServer", True)
 mailfile = session.GetEnvironmentString("MailFile", True)
 Set db = session.getdatabase(server, mailfile)
 Set doc = db.createdocument()
 doc.Form = "Memo"
 doc.SendTo = vAn  ' an array
 If Len(sKopie) > 0 Then doc.copyto = vCopy 'cc Array
 If Len(sBlindKopie) > 0 Then doc.blindcopyto = vBlind 'bcc Array
 doc.Subject = sBetrifft ' die Betreffzeile
 Set rtitem = doc.CREATERICHTEXTITEM("body")
 Call rtitem.APPENDTEXT(sText)
 doc.SAVEMESSAGEONSEND = True
 doc.PostedDate = Now
 
 ' *******************************************

 If sAnhang <> "" Then
  Set AttachMe = doc.CREATERICHTEXTITEM("Attachment")
  Set DerAnhang = AttachMe.EMBEDOBJECT(1454, "", sAnhang, "Attachment")
 End If

 
 'Tabellenblattinhalt löschen
Worksheets("Beinaheunfall").Range("A3:D3,E3:H3,A7:D7,E7:H7,A10:H44").ClearContents

 
 Call doc.Send(False)
Aufraeumen:
 On Error Resume Next
 Set rtitem = Nothing
 Set AttachMe = Nothing
 Set DerAnhang = Nothing
 Set db = Nothing
 Set doc = Nothing
 Set session = Nothing
 
 Kill "C:\Temp\Beinaheunfall.pdf"
 
  
'#################################
'#### Beinaheunfall schließen ####
'#################################
 
Unload UserformBeinaheunfall
 
 Exit Sub
 
Fehler:
 Resume Aufraeumen
 
End Sub
 


Private Sub UserForm_Activate()

Me.TextBoxBeinaheUnfallDatum.Text = Worksheets("Beinaheunfall").Range("A3").Value
'Worksheets("Beinaheunfälle").Range("A2") = TextBoxBeinaheUnfallDatum

End Sub

Vielen Dank im Voraus.

Lg Chris