Kopieren und Format
09.06.2005 18:04:03
GeorgK
mit dem nachfolgenden Makro kopiere ich bestimmte Zeilen in andere Tabellenblätter. Einige Zellen sind farblich unterlegt.
Wie kann ich es erreichen, dass auch die Farbformatierungen übernommen werden?
Dim i As Integer
Dim WsQuelle As Worksheet
Dim WsQuelleLastR As Integer
Dim WsQuelleLastC As Integer
Dim Ws1 As Worksheet
Dim Ws1Last As Integer
Dim Ws2 As Worksheet
Dim Ws2Last As Integer
Sub QuellDatVerteilen()
Set WsQuelle = Worksheets("NePr")
WsQuelleLastR = WsQuelle.Cells(Rows.Count, 1).End(xlUp).Row
WsQuelleLastC = WsQuelle.UsedRange.Columns.Count
Set Ws1 = Worksheets("Schu")
Ws1Last = Ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
Set Ws2 = Worksheets("Kü")
Ws2Last = Ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
Application.ScreenUpdating = False
For i = 2 To WsQuelleLastR
Select Case (WsQuelle.Cells(i, 3))
Case Is = "Schu" 'Wert in Spalte A
Ws1.Range(Ws1.Cells(Ws1Last, 1), Ws1.Cells(Ws1Last, WsQuelleLastC)).Value = WsQuelle.Range(WsQuelle.Cells(i, 1), WsQuelle.Cells(i, WsQuelleLastC)).Value
Ws1Last = Ws1Last + 1
Case Is = "Kü" 'Wert in Spalte A
Ws2.Range(Ws2.Cells(Ws2Last, 1), Ws2.Cells(Ws2Last, WsQuelleLastC)).Value = WsQuelle.Range(WsQuelle.Cells(i, 1), WsQuelle.Cells(i, WsQuelleLastC)).Value
Ws2Last = Ws2Last + 1
End Select
Next
Application.ScreenUpdating = True
End Sub
Vielen Dank für jede Hilfe und Grüße
Georg
Anzeige