VBA Codes

Hi Leute
habe da ein Problem in meiner Arbeitsmappe Aufträge 2022 sind rot markierte Felder
Diese Felder von D bis O sollen fest kopiert werden.
D.H. es gibt mehrere Projekte die mit der KOm.-No versehen sind
Die Felder AG / AH/ BD sollen nur dann kopiert werden wenn das Ereignis = Datum eintritt und zwar jedes für sich einzeln in einer separaten Spalte, so das man in der Timeline Tabelle sieht wann was passiert
Die Timeline soll die Felder der Aufträge Tabelle 2022 wiedergeben so daß man erkennt wann zu welcher Kom welches Ereigniss ansteht
Für jedes neue Datum im Feld AG/AH/BD soll eine neue Zeile geschrieben werden
Quasi eine Timeline wann welches Ereigniss stattfindet aber immer mit dem Zusatz der Felder D-O.
Schaut euch doch bitte mal meine Tabelle an. Könnt ihr helfen ?
Danke Moosi
https://www.herber.de/bbs/user/155034.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Codes

07.09.2022 17:52:25

onur

AW: VBA Codes

09.09.2022 12:35:00

Christiane

AW: VBA Codes

09.09.2022 14:00:44

onur

AW: VBA Codes

12.09.2022 12:18:26

Christiane

AW: VBA Codes

12.09.2022 12:45:45

Daniel

Hallo Onur
vielen Dank für deine Frage
Folgenden VBA Code habe ich


Sub copy_and_paste()
If WorksheetFunction.CountIf(Worksheets("Aufträge 2022").Range("AG:AG"),Value ="D") > 01.01.2022 Then
Worksheets("Aufträge 2022").Range("AG:AG").Copy Destination:=Worksheets("Timelime").Range("A:A")
If WorksheetFunction.CountIf(Worksheets("Aufträge 2022").Range("AH:AH"),Value ="D") > 01.01.2022 Then
Worksheets("Aufträge 2022").Range("AH:AH").Copy Destination:=Worksheets("Timelime").Range("A:A")
If WorksheetFunction.CountIf(Worksheets("Aufträge 2022").Range("BD:BD"),Value ="D") > 01.01.2022 Then
Worksheets("Aufträge 2022").Range("BD:BD").Copy Destination:=Worksheets("Timelime").Range("A:A")
Sheets("Aufträge 2022").Range("AG").Copy Sheets("Timeline").Range("A:A").Offset(1.0)
Sheets("Aufträge 2022").Range("D:D").Copy Sheets("Timeline").Range("B:B").Offset(1.0)
Sheets("Aufträge 2022").Range("E:E").Copy Sheets("Timeline").Range("C:C2").Offset(1.0)
Sheets("Aufträge 2022").Range("H:H").Copy Sheets("Timeline").Range("D:D2").Offset(1.0)
Sheets("Aufträge 2022").Range("K:K").Copy Sheets("Timeline").Range("E:E2").Offset(1.0)
Sheets("Aufträge 2022").Range("M:M").Copy Sheets("Timeline").Range("G:G").Offset(1.0)
Sheets("Aufträge 2022").Range("N:N").Copy Sheets("Timeline").Range("F:F").Offset(1.0)
Sheets("Aufträge 2022").Range("O:O").Copy Sheets("Timeline").Range("G:G").Offset(1.0)
End If
End Sub

Nur leider funktioniert es noch nicht ganz

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread