Sub Sample()
Dim Data As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Set Data = Sheets("Sheet1").Range("A1").CurrentRegion
j = 2
k = 0
With Sheets("Sheet2")
For i = 2 To Data.Rows.Count
If Data.Cells(i, 6) <> "" Then
.Cells(j, 1) = Data.Cells(i, 1)
.Cells(j, 2) = Data.Cells(i, 2)
.Cells(j, 3) = Data.Cells(i, 5)
k = k + 1
If k = 10 Then
j = j + 5
k = 0
Else
j = j + 1
End If
End If
Next i
End With
End Sub