Vor ein paar Tagen habe ich diesesTastenkürzel vorgestellt, mit dem man in MS Office Absätze und Tabellenzeilen nach oben und unten verschieben kann.
Siehe: https://www.konschak.de/office-zeilen-verschieben
In Excel funktioniert dieses Tastenkürzel leider nicht. Mit ein paar Makros in der PERSONAL.XLSB kann man das Verschieben per Tastenkürzel allerdings auch in Excel ermöglichen.
Das komplette Modul stelle ich unten zum Download bereit.
Option Explicit
Option Compare Text
Enum enmWohin
hoch = 1
runter = 2
End Enum
Sub AutoExec()
' Wird beim Starten von Excel ausgeführt und verbindet die Tastenkürzel mit den Makros
On Error Resume Next
Application.OnKey "%+{DOWN}", Procedure:="Selection_nach_unten_verschieben"
Application.OnKey "%+{UP}", Procedure:="Selection_nach_oben_verschieben"
End Sub
Sub Selection_nach_unten_verschieben()
'Alt+Shift+Cursor nach unten
On Error GoTo er
If Selection.Rows(Selection.Rows.Count).Row = ActiveSheet.Cells.Rows.Count Then Exit Sub
Verschiebe runter
ex:
On Error Resume Next
Exit Sub
er:
MsgBox Err.Description, vbInformation, "Fehler beim Versuch zu verschieben..."
Resume ex
Resume
End Sub
Sub Selection_nach_oben_verschieben()
'Alt+Shift+Cursor nach oben
On Error GoTo er
If Selection.Rows(1).Row = 1 Then Exit Sub
Verschiebe hoch
ex:
On Error Resume Next
Exit Sub
er:
MsgBox Err.Description & vbNewLine & Erl, vbInformation, "Fehler beim Versuch zu verschieben..."
Resume ex
Resume
End Sub
Private Sub Verschiebe(Wohin As enmWohin)
'Allgemeine Routine zum Verschieben, wahlweise nach oben oder unten
On Error GoTo er
Dim rng As Range
Dim AnzZeilen As Long
Set rng = Selection
AnzZeilen = rng.Rows.Count
rng.Cut
Select Case Wohin
Case hoch: Set rng = rng.Offset(-1, 0)
Case runter: Set rng = rng.Offset(rng.Rows.Count + 1, 0)
End Select
rng.Insert Shift:=xlDown
Select Case Wohin
Case hoch
Set rng = rng.Offset(AnzZeilen * -1, 0)
Set rng = rng.Resize(rowSize:=AnzZeilen)
Case runter
Set rng = rng.Offset(AnzZeilen * -1, 0)
End Select
rng.Select
ex:
On Error Resume Next
Application.CutCopyMode = False
Exit Sub
er:
MsgBox Err.Description & vbNewLine & Erl, vbInformation, "Fehler beim Versuch zu verschieben..."
Resume ex
Resume
End Sub
Kommentar schreiben