könntest Du Dein nachfolgendes Marko Zeilen verschieben auf Spalten verschieben "umbauen/ ummünzen" ?
Auch Hier sollen alle Farben und Formeln unverändert bleiben!
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_Activate()
Application.OnKey "%{UP}", "moveUP"
Application.OnKey "%{DOWN}", "moveDOWN"
End Sub
Private Sub Workbook_Deactivate()
Application.OnKey "%{UP}"
Application.OnKey "%{DOWN}"
End Sub
' **********************************************************************' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub moveSelection(Optional Direction As String = "up")
Dim rng As Range, objTarget As Worksheet, objSh As Worksheet
Dim rngMove As Range
Dim lngFirst As Long, lngLast As Long, lngMove As Long, lngOld As Long, lngNew As Long
Dim intMove As Integer
On Error GoTo ErrExit
GMS
Set rng = Selection
Set objTarget = rng.Parent
lngFirst = rng.Cells(1, 1).Row
lngLast = lngFirst + rng.Rows.Count - 1
With objTarget
If LCase(Direction) = "up" Then
If lngFirst = 1 Then GoTo ErrExit
lngMove = lngFirst - 1
lngOld = lngFirst - 1
lngNew = lngLast
intMove = -1
Else
If lngLast = Rows.Count Then GoTo ErrExit
lngMove = lngFirst + 1
lngOld = lngLast + 1
lngNew = lngFirst
intMove = 1
End If
Set objSh = Worksheets.Add
.Range(.Cells(lngOld, 3), .Cells(lngOld, Columns.Count)).Copy objSh.Cells(1, 3)
Set rngMove = .Range(.Cells(lngFirst, 3), .Cells(lngLast, Columns.Count))
rngMove.Copy .Cells(lngMove, 3)
objSh.Range(objSh.Cells(1, 3), objSh.Cells(1, Columns.Count)).Copy .Cells(lngNew, 3)
objSh.Delete
rng.Offset(intMove, 0).Select
End With
ErrExit:
GMS True
Set objSh = Nothing
Set rng = Nothing
End Sub Sub moveUP()
moveSelection
End Sub Sub moveDOWN()
moveSelection "down"
End Sub
Public Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
End With
End Sub
Gruß
Lemmi