Private Sub Datenübertragen()
Dim lrow1 As Integer
Dim lrow2 As Integer
Dim lcol As Integer
Dim i As Integer, x As Integer
Dim search As Variant
Dim y As Integer
Dim i2 As Integer
ws.Activate
lrow1 = Cells(Rows.count, 1).End(xlUp).Row
lrow2 = Srow
For i = Srow To lrow1
For x = 2 To lrow2
lcol = Cells(x, Columns.count).End(xlToLeft).Column
If Cells(i, 1).Value = Cells(x, 1).Value Then
Range(Cells(x, 6), Cells(x, lcol)).Copy
Range("F" & i).Select
ActiveSheet.Paste
i2 = i
i = i + 1
For y = 6 To lcol
ws.Cells(i, y) = Application.WorksheetFunction.SumIfs(Worksheets("Data_Input").Range("D:D"), Worksheets("Data_Input").Range("A:A"), ws.Cells(i2, y), Worksheets("Data_Input").Range("B:B"), ws.Cells(i2, 4))
Next y
End If
Next x
Next i
End Sub