Sub DatenvorbereitungRAGReporting()
Dim x As Long, c As Range, fc As String, sm As Double, flag As Boolean, z As Long
With Sheets("Ausgabesheet")
On Error Resume Next
z = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
On Error GoTo 0
End With
With Sheets("Daten Stunden")
For x = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row To 1 Step -1
If .Cells(x, 9).Value <> "" Then
fc = .Cells(x, 9).Address: sm = .Cells(x, 11).Value: flag = False
Set c = .Columns(9).Find(.Cells(x, 9).Value, .Cells(x, 9), xlValues, xlWhole, 2, 1)
If Not c Is Nothing And c.Address <> fc Then
Do
If c.Offset(, 4) = .Cells(x, 13) Then
sm = sm + c.Offset(, 2).Value: flag = True
c.Resize(, 11).ClearContents
End If
Set c = .Columns(9).FindNext(c)
Loop While Not c Is Nothing And c.Address <> fc
End If
End If
If flag Then
.Cells(x, 11).Value = sm
z = z + 1
.Cells(x, 9).Resize(, 11).Copy Sheets("Ausgabesheet").Cells(z, 9)
.Cells(x, 9).Resize(, 11).ClearContents
End If
flag = False
Next x
On Error GoTo Nix
For x = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row To 1 Step -1
If .Cells(x, 9).Value = "" Then .Rows(x).Delete
Next x
On Error GoTo 0
Nix:
End With
End Sub