Sub
CommandButton1_Click()
Dim
Zeile
As
Long
, Spalte
As
Long
, a
As
Long
Application.ScreenUpdating =
False
a = 8
Set
wks = Worksheets(
"Test"
)
For
Each
ws
In
Worksheets
If
ws.Name <>
"Montag"
And
ws.Name <>
"Dienstag"
And
ws.Name <>
"Test"
Then
For
Zeile = 2
To
ws.UsedRange.Rows.Count
If
Left(ws.Cells(Zeile, 2), 1) =
"K"
Then
For
Spalte = 2
To
6
If
ws.Cells(Zeile, Spalte) > 0
Then
wks.Cells(a, Spalte) = ws.Cells(Zeile, Spalte)
End
If
Next
Spalte
End
If
a = wks.Cells.Find(
"*"
, [A1], , , xlByRows, xlPrevious).Row + 1
Next
Zeile
End
If
Next
ws
MsgBox
"Fertig"
End
Sub