daten übertragen in zeile

Hallo zusammen,
Ich habe folgendes Makro:

Private Sub Datenuebernahme_Click()
Range("A8").Select
If ActiveCell.Offset(0, 0).Value  "" Then
Cells(Rows.Count, 1).End(xlUp).Select
End If
ActiveCell.Offset(0, 0).Select
If NameZahlungsempfänger  "" Then
ActiveCell.Value = NameZahlungsempfänger.Value
ActiveCell.Offset(0, 1).Value = CDate(Eingangsdatum)
ActiveCell.Offset(0, 1).NumberFormat = "dd/mm/yyyy"
ActiveCell.Offset(0, 2).Value = Projektnummer
ActiveCell.Offset(0, 3).Value = Art
ActiveCell.Offset(0, 4).Value = CCur(Brutto)
ActiveCell.Offset(0, 5).Value = CCur(Netto)
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).NumberFormat = "#,##0.00 "
ActiveCell.Offset(0, 6).Value = CDate(Faelligam)
ActiveCell.Offset(0, 7).Value = Bezahltam
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).NumberFormat = "dd/mm/yyyy"
ActiveCell.Offset(0, 8).Value = Prio
ActiveCell.Offset(0, 9).Value = AnmerkungZahlmittel
NameZahlungsempfänger.Text = vbNullString
Projektnummer.Text = vbNullString
Art.Text = vbNullString
Brutto.Text = vbNullString
Netto.Text = vbNullString
Faelligam.Text = vbNullString
Bezahltam.Text = vbNullString
Prio.Text = vbNullString
AnmerkungZahlmittel.Text = vbNullString
Application.StatusBar = False
Else
Application.StatusBar = "kein Wert, dann auch kein Eintrag"
End If
NameZahlungsempfänger.SetFocus
End Sub

damit möchte ich aus einer dateneingabemaske Werte in ein anderes datenblatt schreiben und zwar immer an die erste nicht mehr beschriebene Zeile. Funktionierte jetzt knapp 6 Wochen wunderbar - seit gestern abend schreibt er aus unerfindlichen Gründen nicht mehr ein nacheinander immer in die unterste Zeile, sondern macht folgendes:
Der erste Eingabewert wird noch richtig unten eingefügt, alle weiteren eingaben überschreiben die vorherige.
Ich versteh die Welt nicht mehr...wie kann ich den Code safe machen?
Danke,
Lucia

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub Datenuebernahme_Click() Dim rng As Range If Range("A8") "" Then Set rng = Cells(Rows.Count, 1).End(xlUp).Offset(1) Else Set rng = Range("A8") End If If NameZahlungsempfänger "" Then With rng .Value = NameZahlungsempfänger.Value .Offset(0, 1).Value = CDate(Eingangsdatum) .Offset(0, 1).NumberFormat = "dd/mm/yyyy" .Offset(0, 2).Value = Projektnummer .Offset(0, 3).Value = Art .Offset(0, 4).Value = CCur(Brutto) .Offset(0, 5).Value = CCur(Netto) .Offset(0, 4).Resize(, 2).NumberFormat = "#,##0.00 " .Offset(0, 6).Value = CDate(Faelligam) .Offset(0, 7).Value = Bezahltam .Offset(0, 6).Resize(, 2).NumberFormat = "dd/mm/yyyy" .Offset(0, 8).Value = Prio .Offset(0, 9).Value = AnmerkungZahlmittel End With NameZahlungsempfänger.Text = vbNullString Projektnummer.Text = vbNullString Art.Text = vbNullString Brutto.Text = vbNullString Netto.Text = vbNullString Faelligam.Text = vbNullString Bezahltam.Text = vbNullString Prio.Text = vbNullString AnmerkungZahlmittel.Text = vbNullString Application.StatusBar = False Else Application.StatusBar = "kein Wert, dann auch kein Eintrag" End If NameZahlungsempfänger.SetFocus End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread