Macro pour archiver les valeurs sauf lignes ayant un zéro....

Sub ArchivageSansZéro()
Dim ncol%, P As Range, i&, x, rc&, modif As Boolean, j&
ncol = 7 'nombre de colonnes, modifiable
Set P = Feuil1.[B15].CurrentRegion.Resize(, ncol)
With Feuil2
  For i = 2 To P.Rows.Count
    If P(i, 1) <> 0 Then
      x = P(i, 1) & P(i, ncol)
      With .[B4].CurrentRegion
        rc = .Rows.Count
        modif = False
        For j = 2 To rc
          If .Cells(j, 1) & .Cells(j, ncol) = x Then modif = True: Exit For
        Next j
        If modif Then 'ligne d'archive existante
          P.Rows(i).Copy .Cells(j, 1)
          .Cells(j, ncol) = P(i, ncol) 'date
        Else 'nouvelle ligne d'archive
          P.Rows(i).Copy .Cells(rc + 1, 1)
          .Cells(rc + 1, ncol) = P(i, ncol) 'date
        End If
      End With
    End If
  Next i
  .Activate 'facultatif
End With
End Sub