Könnt ihr mit mit dieser Datei weiterhelfen?
https://www.herber.de/bbs/user/136198.xlsm
Ich habe folgenden Code geschrieben, welcher zuerst die gefilterten Daten einer Tabelle in ein neues sheet kopiert.
Das Problem jedoch ist, je nachdem was ich filtere z.B. Nr. 1, 3,5 wird das Format (die braune Füllbarbe) nicht mit kopiert.
Wiest ihr warum das so ist?
Sub copy()
Dim rng As Range
Dim WS As Worksheet
Sheets(4).Rows("9:500").Delete
For Each Row In Range("Tabelle1[#All]").Rows
If Row.EntireRow.Hidden = False Then
If rng Is Nothing Then Set rng = Row
Set rng = Union(Row, rng)
End If
Next Row
Set WS = Sheets(4)
rng.copy Destination:=WS.Range("A8")
Sheets(4).Columns("A").ColumnWidth = 28
Sheets(4).Columns("B").ColumnWidth = 12
Sheets(4).Columns("C").ColumnWidth = 81
Sheets(4).Columns("D").ColumnWidth = 17
Sheets(4).Columns("E").ColumnWidth = 22
Sheets(4).Columns("F").ColumnWidth = 19
Sheets(4).Columns("G").ColumnWidth = 16
Sheets(4).Rows("1:7").RowHeight = 16
Sheets(4).Rows("8").RowHeight = 62
Sheets(4).Rows("9:500").RowHeight = 26
End Sub