Sub EintraegeKopieren()
   
Dim ws As Worksheet
Dim wsTarget As Worksheet
Dim rngSource As Range
Dim i As Integer, j As Integer
Set wsTarget = Sheets("Tabelle2")
   j = 17
            For j = 17 To 100
                    Set rngSource = .Range(.Cells(j, 2), .Cells(j, 5))
                        If rngSource.Cells(1, 3).Value >= 1 Then
                           rngSource.Copy Destination:=wsTarget.Cells(i, 2)
                           Next i
                        End If
            Next j
    
End Sub