Der Übertrag in der Userform (frmLKW) aus der aktiven Tabelle funktioniert einwandfrei. Irgendwie schaffe ich es nicht die Einträge aus der Userform Spalte für Spalte in eine bestehende Datei (siehe strZiel) in die erste freie Zeile einzufügen, zu speichern und zu schließen
Sub Uebertrag()
Dim lngZeile As Long, lngEintrag As Long, lngLaufend As Long, lngNext As Long, strZeit As _
String
Dim strDatum As String, strTage As String, strTag1 As String, strTag2 As String, strSpaet As _
String
Dim lngFarbe As Long, i As Integer, dteZeit As Date
Dim strQuelle As String, strZiel As String
strQuelle = ThisWorkbook.Name
strZiel = "H:\Test\ZweiteDatei.xlsx"
lngZeile = Cells(Rows.Count, 1).End(xlUp).Row ' letzte bef?llte Zeile
lngEintrag = lngZeile + 1 ' n?chste freie Zeile
lngLaufend = Cells(lngZeile, 1).Value 'Nummer des letzten Eintrages
lngNext = lngLaufend + 1 'n?chste fortlaufende Nummer
strZeit = Format((Now), "hh:mm")
With wksDaten
.Cells(lngEintrag, 1) = lngNext
.Cells(lngEintrag, 2) = frmLKW.TextBox5
.Cells(lngEintrag, 3) = frmLKW.TextBoxCO
.Cells(lngEintrag, 4) = frmLKW.ComboBox1
.Cells(lngEintrag, 5) = frmLKW.ComboBox3 'TextBox4
.Cells(lngEintrag, 6) = frmLKW.ComboBox2
.Cells(lngEintrag, 7) = frmLKW.TextBox7
.Cells(lngEintrag, 8) = frmLKW.TextBox8
.Cells(lngEintrag, 9) = frmLKW.TextBox6
.Cells(lngEintrag, 10) = frmLKW.TextBox3
.Cells(lngEintrag, 11) = frmLKW.TextBox2
.Cells(lngEintrag, 12) = strZeit
.Cells(lngEintrag, 13) = strSpaet
.Cells(lngEintrag, 14) = Environ("Username")
End With
With Workbooks(strZiel).Worksheets.wksUebersicht
.Cells(lngEintrag, 1) = lngNext
.Cells(lngEintrag, 2) = frmLKW.TextBox5
.Cells(lngEintrag, 3) = frmLKW.TextBoxCO
.Cells(lngEintrag, 4) = frmLKW.ComboBox1
.Cells(lngEintrag, 5) = frmLKW.ComboBox3 'TextBox4
.Cells(lngEintrag, 6) = frmLKW.ComboBox2
.Cells(lngEintrag, 7) = frmLKW.TextBox7
.Cells(lngEintrag, 8) = frmLKW.TextBox8
.Cells(lngEintrag, 9) = frmLKW.TextBox6
.Cells(lngEintrag, 10) = frmLKW.TextBox3
.Cells(lngEintrag, 11) = frmLKW.TextBox2
End With
With Workbooks(strZiel)
.Save
.Close
End With
End Sub
Gruss Lorenz