Sub Большая_Северная_Беленькая_Лисичка()
    Dim Table(), dict
    Dim Revised()
    Dim lLastRow As Long, i As Long, g As Long, Sh As Worksheet
    Set dict = CreateObject("scripting.dictionary")
    Set Sh = ActiveSheet
    lLastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    Table = Sh.Range("A1:I" & lLastRow).Value
    For i = 1 To lLastRow
        If Table(i, 8) <> 0 Then
            dict.Item(i) = i
        End If
    Next i
    keys = dict.keys
    If dict.Count = 0 Then Exit Sub
    ReDim Revised(1 To dict.Count, 1 To 9)
    For i = 0 To UBound(keys)
        For g = 1 To 9
            Revised(i + 1, g) = Table(keys(i), g)
        Next
    Next

End Sub