Zeilen/Spalten "mitten hinein" verschieben - per Tastenkürzel

[cysu11]

Hi Andre,


ich habe mein PC gestern neu aufgesetzt und die Testdatei leider gelöscht. Habe aber jetzt eine neue Testdatei gemacht und die Codes angepasst und nun funktionieren nun genau so wie sie sollen! :)

LG
Alexandra

[ibu]

Hallo Alexandra.

Erstmal vielen Dank für Deine Anpassungen.

Ich habe Deine Datei geladen, finde dort jedoch keine Makros.

Übersehe ich etwas oder hast Du sie versehentlich nicht mit gespeichert?

VG Andreas

[schauan]

Hallöchen,

dann hier mal ein Ansatz, wie es auch mit B2 nach rechts funktionieren könnte. man muss halt schauen, dass man als Ausgangspunkt für das versetzen einer ganzen Zeile oder Spalte immer eine passende Zelle am Blattrand zum Einfügen nimmt oder man programmiert gleich nur die Spalten / Zeilen.

Code:

Sub Eins_Rechts()
If TypeName(Selection) = "Range" Then
With Selection
  .EntireColumn.Cut
  Cells(1, .Offset(0, 2).Column).Insert xlToRight
End With
End If
End Sub

oder einfacher so:

Code:

Sub Eins_Rechts()
If TypeName(Selection) = "Range" Then
With Selection.EntireColumn
  .Cut
  .Offset(0, 2).Insert xlToRight
End With
End If
End Sub

[cysu11]

So jetzt mit Vba-Codes! :)

[ibu]

Whow!

Das ist ja toll!

Funktioniert exakt so, wie ich es mir gewünscht hatte.

Ganz herzlichen Dank an alle, die dazu beigetragen haben :)


Kleinigkeit noch:
wenn man eine Zelle markiert und dann die Funktion "links" wählt ist danach die ganze Spalte markiert.
ideal wäre es, wenn der nach Ausführen des Makros auch weiterhin nur die einzelne Zelle markiert wäre.
Wenn also vor und nach dem Makro dieselbe Zelle markiert ist.

Bei der Funktion "rechts" passiert hinsichtlich Markieren etwas überraschendes. Es ist danach nicht die Spalte markiert, wo der Cursor zuvor war, sondern die Spalte rechts daneben.

Analog gilt das für oben und unten.

Bei "oben" ist danach dieselbe Spalte markiert. Bei "unten" die darunter liegende.

Falls sich das noch einfach beheben lässt, wäre das schön. Ansonsten freue ich mich über die aktuelle Funktion schon sehr. Das ist so hilfreich endlich völlig unkompliziert mit einem einzigen Tastendruck verschieben zu können.

[cysu11]

Hi,


kein Problem :)

LG
Alexandra

[schauan]

Hallöchen,

ich würde noch eine Sicherung einbauen und prüfen, ob ich im "grenzwertigen" Randbereich bin.
z.B. bei NachOben geht's in Zeile 1 nicht höher, daher gleich nach Sub … diese Zeile :

If Selection.Row = 1 Then Exit Sub

usw.

[cysu11]

Hallo Andre,


stimmt, sonst würde auf Fehlermeldung laufen wenn man die erste Zeile nach oben schieben oder die erste Spalte nach links! 

Code:

Sub nachoben()
Dim ur As Range
Set ur = ActiveCell
ActiveCell.EntireRow.Select
If Selection.Row = 1 Then
ur.Select
Exit Sub
End If
Selection.Cut
Selection.Offset(-1, 0).Select
Selection.Insert shift:=xlUp
Application.CutCopyMode = False
ur.Select
End Sub
Sub nachunten()
Dim ur As Range
Set ur = ActiveCell
ActiveCell.EntireRow.Select
Selection.Cut
Selection.Offset(2, 0).Select
Selection.Insert shift:=xlDown
Application.CutCopyMode = False
ur.Select
End Sub
Sub nachlinks()
Dim ur As Range
Set ur = ActiveCell
ActiveCell.EntireColumn.Select
If Selection.Column = 1 Then
ur.Select
Exit Sub
End If
Selection.Cut
Selection.Offset(0, -1).Select
Selection.Insert shift:=xlToLeft
Application.CutCopyMode = False
ur.Select
End Sub
Sub nachrechts()
Dim ur As Range
Set ur = ActiveCell
ActiveCell.EntireColumn.Select
Selection.Cut
Selection.Offset(0, 2).Select
Selection.Insert shift:=xlToRight
Application.CutCopyMode = False
ur.Select
End Sub

LG
Alexandra

[ibu]

neuen Dokumenten) zur Verfügung, ohne dass das ursprüngliche Dokument geöffnet sein muss.Hallo Alexandra.

Nochmal vielen Dank für Dein schönes Makro, ich verwende es viel :)

Zu Deiner letzten Nachricht:

Verstehe ich es richtig, dass

Code:

If Selection.Row = 1 Then
ur.Select
Exit Sub
End If

in das Makro "Nach links" werden muss und

Code:

If Selection.Column = 1 Then
ur.Select
Exit Sub
End If

in das Makro "Nach oben"?

Falls Du Zeit findest, lade doch bitte eine aktualisierte Version Deines Makros hoch.

Davon unabhängig:

Verstehe ich es richtig, dass man den Code in PERSONAL.XLSB kopieren muss, damit er global (also auch in neuen Dokumenten) zur Verfügung, ohne dass das ursprüngliche Dokument geöffnet sein muss?

Leider tue ich mich schwer damit, über "Menüband Entwicklertools > Makros" den Weg zu finden. Dort scheint es keine Kopier/Import/Exportfunktionen zu geben. Oder übersehe ich es?

[schauan]

Hallo Andreas,

als Antwort auf die Frage nach dem wohin von If Selection.Row = 1 Then mal zwei Zitate.

aus Alexandras Code:

Code:

Sub nachoben()
Dim ur As Range
Set ur = ActiveCell
ActiveCell.EntireRow.Select
If Selection.Row = 1 Then
ur.Select
Exit Sub
End If
...

und meine Antwort davor:

z.B. bei NachOben geht's in Zeile 1 nicht höher, daher gleich nach Sub … diese Zeile :

If Selection.Row = 1 Then Exit Sub

Du musst zu jeder Richtung prüfen, ob da noch platz ist. Nach oben oder unten prüfst Du, in welcher Zeile Du jeweils bist, also entweder 1 oder Rows.Count, und bei den Spalten rechts und links analog auch die 1 oder Columns.Count