Boa noite, jau288.

Vê se isso te ajuda.

Sub SemZero()

Dim x As Long
Dim i As Long
Dim c As Long
Dim UltCol As Long
Dim UltLin As Long
    
    UltLin = Cells(Rows.Count, 2).End(xlUp).Row
    UltCol = Cells(2, Columns.Count).End(xlToLeft).Column
    
    For x = 2 To UltLin
    
        c = 3

        For i = 2 To UltCol
        
            If Cells(x, i) <> 0 Then
                Cells(x + 15, c) = Cells(x, i)
                c = c + 1
            End If

        Next i

    Next x

End Sub

Bom dia Trindade, obrigado pela atenção...
Quanto este código não consegui rodar...

Bom dia colega,

Eu testei a rotina criada pelo Trindade e aparentemente está funcionando perfeitamente.

Abraços.

Bom dia, jau288.

O amigo Fabiosp anexou um arquivo com botão mas sem ação ou código na planilha.

Testa ai novamente, simplesmente peguei o código e coloquei em um botão na planilha.

Bom dia .agradeço a ajuda , e obrigado pela atenção...
Está perfeito ...

Encerendo...