Clever-Excel-Forum

Hallo zusammen,

ich bin neu in diesem Forum und benötige euren Rat zu folgendem Problem.
Ich habe in einem Excel Tabellenblatt hunderte verschiedene Bauvorhaben angeführt (Spalte B). Unter anderem soll damit über einen Zeitraum von 3 Jahren eine grobe Personaleinsatzsteuerung gemacht werden.
Für jedes Bauvorhaben sind 9 Zeilen für die erforderlichen Ressourcen (Spalte C) angelegt. (Zeile 7 Bauleiter Bauvorhaben 1, Zeile 8 Polier Bauvorhaben 1, Zeile 9 Kranfahrer Bauvorhaben 1, usw.).
Die Spalten D bis APG stellen die einzelnen Kalendertage (2020-2022) dar. Hier wird die jeweils erforderliche Anzahl an Kranfahrer, Polier usw. tagesgenau eingetragen.

Mein Problem:
Angenommen einige dieser (hunderte) Bauvorheben verschieben sich nach vor oder zurück. Kann man ein Makro erstellen, das die Zeile der zugehörigen Ressource (Bauleiter, Kranfahrer...) automatisch um eine bestimmte Anzahl an Tagen nach rechts (Späteres Datum) oder nach links (früheres Datum) verschiebt.? So ähnlich wie bei dem YouTube Video „Google Tabellen“ https://www.youtube.com/watch?v=Dj7DKAK0rbs

Im Anhang habe ich einen kleinen Ausschnitt der Datei angefügt.

Ich wäre euch echt dankbar für einige Ratschläge wie ich das hinbekommen kann.

LG STM

Hi
das sollte helfen

Code:
Sub Verschieben()

    Dim lVerschiebung As Long

    Dim a As Range, b As Range, c As String

    With ActiveSheet.Columns("B")

        Set a = .Find(InputBox("Projektname", , "Bauvorhaben 1"))

        lVerschiebung = InputBox("Verschiebug in Tagen")

        If Not a Is Nothing Then

            c = a.Address

            Do

                If lVerschiebung < 0 Then

                    Set b = Range(a.Offset(, 2 - lVerschiebung), Cells(a.Row, Columns.Count).End(xlToLeft))

                    b.Offset(, lVerschiebung) = b.Value

                    b.Offset(, b.Columns.Count + lVerschiebung).Resize(, -lVerschiebung).Clear

                Else

                    Set b = Range(a.Offset(, 2), Cells(a.Row, Columns.Count).End(xlToLeft))

                    b.Offset(, lVerschiebung) = b.Value

                    b.Resize(, lVerschiebung).Clear

                End If

                Set a = .FindNext(a)

            Loop While Not a Is Nothing And a.Address <> c

        End If

    End With

End Sub

Viel Erfolg.

STM

Raoul21