Bedingung erfüllt Zeilen in neues Blatt
04.01.2022 09:30:53
Jürgen
erstmal ein Gutes neues Jahr an alle. Ich bin neu hier im Forum und meine VBA Kenntnisse halten sich leider sehr in Grenzen.
Ich habe hier schon sehr viel durchsucht, habe es aber leider nicht geschafft mein Problem zu lösen.
Ich werde versuchen die Datei mit anzuhängen, weiß aber nicht ob es funktioniert :(
Kurz zu meiner Ausgangssituation:
Ich habe eine Datei "Morgenbesprechung" welche aus den Tabellenblättern "KW01, KW02, KW03 usw. besteht und
1 Tabellenblatt Aktivitätenplan welches Aktivitätenplan heißt.
Die Tabellenblätter KW01, KW02.. usw teilen sich wie folgt auf
B = Abteilung
C - I = Thema (Spalten verbunden)
J - N = Aktivität (Spalten verbunden)
O - P = Verantwortlich (Spalten verbunden)
Q = Termin
R = Aktivität mit Auswahl "JA"
Zu meinem Vorhaben:
Wenn in einem Tabellenblatt KW01, KW02 usw. der Spalte R "JA" ausgewählt wird, soll die zugehörige Zeile (nur der Inhalt) von B:Q in das Tabellenblatt "Aktivitätenplan" übertragen werden, beginnend ab der Spalte B, Zeile 2.
Es werden dann auch Einträge ohne "JA" erfolgen und wenn wieder in der Spalte R "JA" ausgewählt wird soll diese Zeile dann in die erste freie vom Aktivitätenplan eingetragen werden.
Ich habe es geschafft von KW01 mittels Button die Zeilen zu übertragen. Leider hat es mir im Aktivitätenplan die Spalte R = Status immer überschrieben und es wurde nur mit der Formatierung übertragen. Wenn ich dann in KW02 etwas eingetragen habe, hat es die bereits bestehenden Zeilen im Aktivitätenplan überschrieben. (hier habe ich dann nur With Worksheets ("KW02") geschrieben)
Ich hoffe das ich das Problem halbwegs verständlich darlegen konnte.
Der Code welchen ich benutzt habe sieht wie folgt aus:
Private Sub CommandButton1_Click()
Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long
With Worksheets("KW01")
RowMax = 18
n = 2
For Zeile = 1 To 18
If .Cells(Zeile, 18).Value = "JA" Then
.Rows(Zeile).Copy Destination:=Worksheets("Aktivitätenplan").Rows(n)
n = n + 1
End If
Next Zeile
End With
End Sub
LG,
Jürgen
https://www.herber.de/bbs/user/150123.xlsm