Office: (Office 2016) Werte aus Zellen A1-D1 in nächste freie Zelle schreiben

Hallo allerseits,
ich bin mir durchaus bewusst, dass es für mein Problem etliche Lösungen gibt. Jedoch unterscheiden sich diese teils deutlich von einander und ich werde einfach nicht schlau daraus. Hier also zu meinem Problem:

Ich möchte, dass die eingetragenen Werte der Tabelle der Zellen A1 : D1 in die jeweils nächsten freien Zellen kopiert werden. Anschließend sollen die Zellen A1 : D1 wieder geleert werden. Es handelt sich bei den Eingaben um Text, Datum und Zahlen.

Ich würde mich sehr freuen, wenn mir jemand eine entsprechende Lösung bereitstellen könnte.

Vielen Dank und einen schönen Sonntag

 

Hi,

wie sollen die Daten denn kopiert werden - mit einem Makro welches an einen Button im Tabellenblatt gebunden ist?

Bis später,
Karin

 

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.EnableEvents = False
 c = Target.Column
 If Target.Row = 1 And c < 5 Then
  If Cells(2, c) = "" _
   Then Cells(2, c) = Target _
   Else Target.End(xlDown).Offset(1, 0) = Target
  Cells(1, c Mod 4 + 1).Select      'als Zusatznutzen
  Target.ClearContents
 End If
 Application.EnableEvents = True
End Sub

Den o.g. Code mit Strg-C kopieren
Rechtsklick auf Tabellenreiter, "Code Anzeigen"
Strg-V
Mappe als .xlsm abspeichern

Datum-Format in Konflikt mit Zahl (schon bei der Eingabe: "Datum gewinnt!"). Falls jedoch 1 Spalte nur für Datümer, dann diese einfach so vorformatieren!

Sinnvoll wäre noch eine FreezePanes- (oder geteilter Schirm) Einrichtung, so dass man oberhalb der Linie in Zeile 1 eingibt, und der untere Bereich am Spaltenende immer sichtbar ist. Das geht natürlich nur bei Datensatz-Erfassung, nicht bei unregelmäßiger Spaltenfüllung, da das Spaltenende A ja Tausende Zeilen von B unterschiedlich sein kann.

 

Moin auch von mir!
Alternative:
(das Ausschalten der Events spare ich mir (hier), es wird nur eine "Ehrenrunde" gedreht)

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Set Bereich = Range("A1:D1")
If Not Intersect(Target, Bereich) Is Nothing Then
  If WorksheetFunction.CountBlank(Bereich) = 0 Then
    Bereich.Cut Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Application.Goto Cells(1)
  End If
End If
End Sub

Gruß Ralf

 

1. Schön die Lösung mit dem Kopieren ERST DANN, sobald die Daten komplett gefüllt sind (ermöglicht Datensatzhomogenität)!

2. EnableEvents = False wurde bei mir erst nötig, als ich die Zeile .ClearContents verwendete, die ich zunächst vergessen hatte.

3. "Die nächsten freien Zellen" sind für mich nicht unbedingt am Ende. Sondern eben die NÄCHSTEN. Mit hoher Wkt. hast Du aber die Absicht des - hier ungenau formulierenden - TE trotzdem richtig erwischt, da sie eher dem Lebenssachverhalt entspricht.

4. .Goto kannte ich noch nicht. Interessant! Bei geteiltem Fenster also ein Vehikel zum Scrollen?