20.09.2016, 10:25
Hallo Freunde,
ich bin auf der Suche nach einer Makrolösung für folgenden Sachverhalt:
- kopiere Thema, Termin und Verantwortlichen, aber nur für Zeilen, die mit "x" gekennzeichnet sind
- füge es in "Dashboard" ein (in dafür vorgesehene Tabelle) ACHTUNG: Tabelle ist dynamisch und kann nach oben und unten verschoben sein (Also kein direkter Zellbezug)
Folgenden Vorschlag habe ich zu machen:
Der letzte For ... Next Bereich irgendwie angepasst werden.
Im Anhang eine Bsp. Datei:
Vielen Dank
Berndt
ich bin auf der Suche nach einer Makrolösung für folgenden Sachverhalt:
- kopiere Thema, Termin und Verantwortlichen, aber nur für Zeilen, die mit "x" gekennzeichnet sind
- füge es in "Dashboard" ein (in dafür vorgesehene Tabelle) ACHTUNG: Tabelle ist dynamisch und kann nach oben und unten verschoben sein (Also kein direkter Zellbezug)
Folgenden Vorschlag habe ich zu machen:
Code:
Private Sub CommandButton3_Click()
Dim i&, k&, a ' i und z braucht man immer, a+b sind "Arrays"
Dim bis& ' & = as long
Const von = 6 ' erste Zeile mit Daten
Application.ScreenUpdating = False
bis = Range("B" & Rows.Count).End(xlUp).Row + 1
a = Range("B" & von & ":E" & bis)
For i = 1 To UBound(a)
If a(i, 2) = "x" Then
bis = Sheets(a(i, 3)).Range("B2000").End(xlUp).Row + 1 ' 2000 reicht hier ja...
If IsError(Application.Match(a(i, 1), Worksheets(a(i, 3)).Range("B1:B" & bis), 0)) Then
Sheets(a(i, 3)).Range("B" & bis) = a(i, 1)
Sheets(a(i, 3)).Range("C" & bis) = a(i, 4)
Sheets(a(i, 3)).Range("B8:C8").Copy ' da ist das gleiche Format
Sheets(a(i, 3)).Range("B" & bis).Resize(, 2).PasteSpecial xlFormats
End If
End If
Next
For i = 1 To UBound(a)
If a(i, 2) = "x" Then
bis = Sheets(a("Dashboard")).Range("B2000").End(xlUp).Row + 1
If IsError(Application.Match(a(i, 1), Worksheets(a("Dashboard")).Range("B1:B" & bis), 0)) Then
Sheets(a("Dashboard")).Range("B" & bis) = a(i, 1)
Sheets(a("Dashboard")).Range("E" & bis) = a(i, 4)
Sheets(a("Dashboard")).Range("F" & bis) = a(i, 3)
End If
End If
Next
Application.ScreenUpdating = True
End SubDer letzte For ... Next Bereich irgendwie angepasst werden.
Im Anhang eine Bsp. Datei:
Vielen Dank
Berndt