Sub Test()
k = 2
For i = 2 To Worksheets.Count
Worksheets(i).Activate
zName = [C1].Value
zPren = [C2].Value
For Each o In Range('F8:F' & Cells.SpecialCells(xlLastCell).Row)
o.Activate
j = o.Row
If o.Value > 0 Then
Worksheets(1).Cells(k, 1).Value = zName
Worksheets(1).Cells(k, 2).Value = zPren
Range(Cells(j, 1), Cells(j, 7)).Copy Worksheets(1).Cells(k, 3)
k = k + 1
End If
Next
Next
End Sub