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

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais, à nouveau, votre aide pour modifier cette macro, afin d'archiver les valeurs sans les lignes ayant la valeur 0 en colonne B.

Voir fichier joint.

Merci pour votre aide, si précieuse.
Bien amicalement,
Christian

 

[job75]

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

Re,

Une solution plus élaborée s'il s'agit de modifier les lignes d'archive existantes :

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

Le test (sur x) porte sur la 1ère colonne (B) et la dernière (date).

A+