[VBA] Makierung von mehreren Zellen (Varialble Anzahl) um eine Spalte nach Rechts?

[Ratboss]

Moin,

Eventuell eine einfache Sache, aber ich bin nicht besonders gut in VBA.
Ich suche schon seit Stunden nach einer Lösung, um die Makierung von Zellen um eine Position nach Rechts zu versetzen.

Das Problem ist:
Es wird eine fortlaufende Tabelle erzeugt, in der immer neue Werte untereinander aufgelisted werden.
Per Makro kann ich zwar bei neuen Einträgen die Zellen in der Letzen Spalte markieren, möchte aber diese Markierung nun im VBA um eine Spalte nach rechts verschieben.
Siehe gestelltes Beispiel. Sprich wo immer diese Makierung ist, wie viele Zeilen sie auch immer hatt, um eine Position nach Rechts.

Kennt jemand eine eineache Lösung/Befehl im VBA der mir dieses ermöglichen kann?

[
Bild bitte so als Datei hochladen: Klick mich!
]

[
Bild bitte so als Datei hochladen: Klick mich!
]

Vielen Dank.
G.T.Schröder

[schauan]

Hallöchen,

kennst Du den Befehl Offset?

z.B.
msgbox range("A1").Offset(2,3).Address

oder
range("A1").Offset(2,3).select

[RPP63]

Hi!
Ergänzend mal ohne Offset, denn die letzte Spalte muss ja ohnehin ermittelt werden:

Sub SchiebMal()
Dim lZeile As Long, lSpalte As Long
With Tabelle1
   lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
   lSpalte = .Cells(lZeile, .Columns.Count).End(xlToLeft).Column
   .Range(.Cells(2, lSpalte), .Cells(lZeile, lSpalte)).Cut .Cells(2, lSpalte + 1)
End With
End Sub

Gruß Ralf

[Rabe]

Hi Ralf,

  .Range(.Cells(2, lSpalte), .Cells(lZeile, lSpalte)).Cut .Cells(2, lSpalte + 1)

ich mag mich irren, aber da stand doch nix von Inhalte verschieben, sondern nur von "Markierung versetzen", also nicht den Inhalt.

[Ratboss]

Moin,

vielen dank für die Antworten!


Ja Rabe, verschieben/Versetzen ist genau richtig!


So gleich mal ausprobieren was Ralf als möglichkeit geantwortet hat.

[Ratboss]

Nochmals Danke für die Hilfe.

mit etwas probieren war das die Lösung:

Selection.Offset(0, 1).Select

[Kuwer]

Hallo,

hier mal noch für alle vier Richtungen mit Überlauf zum anderen Ende:

Sub MarkierungVerschiebenNachLinks()
 Dim lngOffset As Long
 If TypeName(Selection) = "Range" Then
   With Selection
     lngOffset = -(.Column = 1) * (Columns.Count - .Columns.Count + 1) - 1
     .Offset(0, lngOffset).Select
   End With
 End If
End Sub

Sub MarkierungVerschiebenNachRechts()
 Dim lngOffset As Long
 If TypeName(Selection) = "Range" Then
   With Selection
     lngOffset = (.Column = (Columns.Count - .Columns.Count + 1)) * (Columns.Count - .Columns.Count + 1) + 1
     .Offset(0, lngOffset).Select
   End With
 End If
End Sub

Sub MarkierungVerschiebenNachOben()
 Dim lngOffset As Long
 If TypeName(Selection) = "Range" Then
   With Selection
     lngOffset = -(.Row = 1) * (Rows.Count - .Rows.Count + 1) - 1
     .Offset(lngOffset, 0).Select
   End With
 End If
End Sub

Sub MarkierungVerschiebenNachUnten()
 Dim lngOffset As Long
 If TypeName(Selection) = "Range" Then
   With Selection
     lngOffset = (.Row = (Rows.Count - .Rows.Count + 1)) * (Rows.Count - .Rows.Count + 1) + 1
     .Offset(lngOffset, 0).Select
   End With
 End If
End Sub

In der Beispielmappe wird die Steuerung automatisch auf die Tastenkombinationen ALT+Pfeiltaste gelegt:

Private Sub Workbook_Activate()
 'Makros Tastenkobinationen zuweisen 
 Application.OnKey "%{LEFT}", "MarkierungVerschiebenNachLinks"
 Application.OnKey "%{RIGHT}", "MarkierungVerschiebenNachRechts"
 Application.OnKey "%{UP}", "MarkierungVerschiebenNachOben"
 Application.OnKey "%{DOWN}", "MarkierungVerschiebenNachUnten"
End Sub

Private Sub Workbook_Deactivate()
 'Zuweisungen wieder aufheben 
 Application.OnKey "%{LEFT}"
 Application.OnKey "%{RIGHT}"
 Application.OnKey "%{UP}"
 Application.OnKey "%{DOWN}"
End Sub

Gruß Uwe

[juliatoll]

Hallöchen,

mit Fehlertoleranz gehts auch einfach so:

Code:

Sub Nach_Rechts_Einfach()
On Error Resume Next
Selection.Offset(0, 1).Select
End Sub
Sub Nach_Links_Einfach()
On Error Resume Next
Selection.Offset(0, -1).Select
End Sub
Sub Nach_Oben_Einfach()
On Error Resume Next
Selection.Offset(-1, 0).Select
End Sub
Sub Nach_Unten_Einfach()
On Error Resume Next
Selection.Offset(1, 0).Select
End Sub

Aber: Mein spezieller Dank an Uwe, der hier eine tolle Tastensteuerung für Makros eingebaut hat.
Hab die Datei runtergeladen und werde das neue Wissen reichlich einsetzen.