AW: Verschieben innerhalb eines Bereiches
25.07.2018 23:25:22
Barbaraa
Hallo Ibo,
probier mal das:
Setze folgendes Makro in das Modul von "Tabelle8 (vorher)".
Private Sub Worksheet_Change(ByVal rTarget As Range)
Dim rAnfang As Range
Dim rEnde As Range
If rTarget.Row = 17 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
If rTarget = "x" Then
Set rEnde = Cells(17, Cells(2, 3).End(xlToRight).Column)
Do
Set rAnfang = Rows(17).Find(What:="x", After:=rEnde, _
LookAt:=xlWhole, SearchDirection:=xlPrevious).Offset(0, 1)
If rEnde.Column > rAnfang.Column Then
Range(Cells(3, rAnfang.Column), Cells(16, rEnde.Column - 1)).Copy
Cells(3, rAnfang.Column + 1).PasteSpecial
End If
Set rEnde = Rows(17).Find(What:="", After:=rAnfang, _
LookAt:=xlWhole, SearchDirection:=xlPrevious)
If rEnde.Column rAnfang.Column Then
Range(Cells(3, rAnfang.Column + 1), Cells(16, rEnde.Column)).Copy
Cells(3, rAnfang.Column).PasteSpecial
End If
Set rAnfang = Rows(17).Find(What:="", After:=rEnde, _
LookAt:=xlWhole, SearchDirection:=xlNext)
Range(Cells(3, rAnfang.Column), Cells(16, rAnfang.Column)).Copy
Cells(3, rEnde.Column).PasteSpecial
Loop
Set rEnde = Cells(17, Cells(2, 3).End(xlToRight).Column)
Range(Cells(3, rAnfang.Column + 1), Cells(16, rEnde.Column)).Copy
Cells(3, rAnfang.Column).PasteSpecial
Range(Cells(3, rEnde.Column), Cells(16, rEnde.Column)).ClearContents
Range(Cells(2, rEnde.Column), Cells(17, rEnde.Column)).Interior.Color = 16777215
End If
rTarget.Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
Es wird automatisch aufgerufen, wenn Du ein x in Zeile 17 schreibst oder löschst.
Wenn in Zeile 17 ein x GESETZT wird, werden alle Einträge und Farben dieses Tages und aller folgenden Tage um eine Spalte nach rechts geschoben und dieser Tag orange gesetzt. Folgenden Tage, die ein x haben, behalten dieses und werden beim Verschieben übersprungen.
Wenn in Zeile 17 ein x GELÖSCHT wird, werden alle Einträge und Farben aller folgenden Tage um eine Spalte nach links geschoben und der letzte Tag des Zeitstrahls weiß gesetzt. Folgenden Tage, die ein x haben, behalten dieses und werden beim Verschieben übersprungen.
Funktioniert es?
LGB