Teil einer Tabelle um eine Zeile nach unten verschieben

[Sagulum]

Hallo allerseits
 
Ich bin immer noch Excel-Neuling und hoffe ihr könnt mir helfen :17:
 
 
Ich möchte in einer Tabelle mit 3 Spalten und fester Länge, die Daten aller 3 Spalten inklusive der aktiven Zelle um eine Zeile nach unten verschieben.
 
 
Also nur wenn die aktive Zelle in Spalte 1 liegt sollen, nach Klick auf einen Button, alle Daten in dieser Zeile und alle darunter um eine Zeile nach unten verschoben werden. Nach Möglichkeit zuerst Prüfung ob die Tabelle schon voll ist, wenn ja mit Abbruch und Meldung das die Tabelle voll ist.
 
Siehe auch Beispieltabelle im Anhang.


  Verschieben-Test.xlsm (Größe: 32,14 KB / Downloads: 6)

[lupo1]

Also genau das, was mit Rechtsklick auf die Zeilennummer und dann "Zellen einfügen" passiert?

Zeichne das doch mal auf! Und weise das dann einem Commandbutton zu.

[Sagulum]

Hallo lupo1

Ist leider nicht so einfach. In der Endversion befinden sich neben der Tabelle noch weitere Tabellen und die sollen so bleiben wie sie sind.

Gruß Sagulum

[lupo1]

Das nennt man dann einen Designfehler. Aber:

Sub Makro1()
   If ActiveCell.Column = 1 Then Cells(ActiveCell.Row, 1).Resize(, 3).Insert xlDown
End Sub

[Sagulum]

Hallo lupo1

Deine Lösung haut bei mir nicht so richtig hin. Habe mir mal was ausgedacht, das klappt aber nur im ersten Schritt und auch nur zum Teil.
1. Die unteren Werte rutschen bis ans Ende der Tabelle.
2. Ich habe keine Idee, die restlichen Zeilen bis zur aktiven Zelle, auch eine Zeile runter zu kopieren.

Gruß Sagulum


  Verschieben-Test.xlsm (Größe: 34,34 KB / Downloads: 4)

[Glausius]

Hallo,

hast du es schon einmal damit versucht:

Code:

Sub Zeilen_verschieben()
    Range("C11:E11").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

(Bereich, der verschoben werden soll, gegebenenfalls anpassen!)

[atilla]

Hallo,

teste mal folgendes:

Code:

Private Sub CommandButton1_Click()
  Dim i
  Dim lngZ As Long
  If Not Intersect(Selection, Range("berErsteSpalte")) Is Nothing Then 'Wenn ausgewählte Zelle im Bereich
    lngZ = Cells(Range("berErsteSpalte").Rows.Count + Range("berErsteSpalte").Row, Range("berErsteSpalte").Column).End(xlUp).Row
    If lngZ - Range("berErsteSpalte").Row + 1 < Range("berErsteSpalte").Rows.Count Then
      If Selection <> "" Then
        i = Selection.Row
        Range(Cells(i + 2, 3), Cells(lngZ + 1, 5)).Value = Range(Cells(i + 1, 3), Cells(lngZ, 5)).Value
        Range(Cells(i + 1, 3), Cells(i + 1, 5)).ClearContents
      End If
    Else
      MsgBox "Daten können nicht weiter nach unten geschoben werden"
    End If
  Else
    MsgBox "Auswahl liegt nicht im definierten Bereich!"
  End If
End Sub

Und Deine Prüfung mit Worksheet_SelectionChange geht einfacher und ohne Schleife:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   'Prüfen ob der Klick im Bereich "berFilter" liegt, wenn nicht wird die Sub beendet
   If Not Intersect(Target, Range("berErsteSpalte")) Is Nothing Then
     If Application.CountA(Range("berErsteSpalte")) = Range("berErsteSpalte").Cells.Count Then
       MsgBox "Die Tabelle ist voll"
'        Exit Sub
     End If
   End If

End Sub

[Sagulum]

Hallo atilla

Vielen Dank für deine Hilfe. Deine Lösung des Problems macht genau, dass was ich wollte. :18:

Auch den anderen möchte ich für ihre Hilfe danken.

Viele Grüße Sagulum