VBA - copier les lignes des bases si données différent de 0

Bonjour à tous,

Je suis débutant en macro. J'utilise beaucoup les enregistrements pour réaliser les macros.

Je suis face à un problème, et j'ai besoin de votre avis et de votre aide pour m'aider à le résoudre.

Etape 1 :

1.1 Je souhaite copier les données de la base 1 (colonne A4 à D28) si les colonnes C et D sont différents de 0 (si les valeurs de la colonne C et D sont égales à 0 ne pas copier les données.

1.2 Coller ces données dans l'onglet Final.

Ci joint un exemple excel (avec la macro):

Pouvez vous m'aider ?

Merci d'avance.

Cordialement

Bonjour,

voici un exemple,

Sub copy_filtre_Non0()
Dim sh1, sh2
Dim LastRw&

Set sh1 = Sheets("Base 1")
Set sh2 = Sheets("Final")
LastRw = sh2.Cells(Rows.Count, 1).End(xlUp).Row

sh1.Range("A3:D3").AutoFilter
sh1.Range("A3").CurrentRegion.AutoFilter Field:=3, Criteria1:="<>0"
sh1.Range("A3").CurrentRegion.AutoFilter Field:=4, Criteria1:="<>0"
sh1.Range("_FilterDatabase").SpecialCells(xlCellTypeVisible).Copy sh2.Range("A" & LastRw)

sh1.Range("A3").AutoFilter
Set sh1 = Nothing
Set sh2 = Nothing
End Sub

Bonjour,

Merci de ta réponse. J'ai essayé ta macro. Le problème c'est que je ne récupère pas toutes les informations.

Je souhaite récupérer ces informations :

Si Quantité (de C2 à C13) <> 0 et Stocks (de D2 à D13)<> 0, alors copier de A2 à D2 dans Final, sinon ne rien faire et passer à la ligne suivante.

Est ce que c'est possible ?

Merci d'avance

Voici le résultat souhaité :

Bonjour,

voilà,

Sub transfert()
Dim i&, tablo, sh1, sh2
Dim LastRw1 As Long, LastRw2 As Long

Set sh1 = Sheets("Base 1")
Set sh2 = Sheets("Final")
sh2.Columns("A:D").ClearContents
LastRw1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
LastRw2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row

    tablo = sh1.Range(sh1.Cells(3, "A"), sh1.Cells(LastRw1, "D"))
    For i = 1 To UBound(tablo)
      If tablo(i, 1) = "Commande" Or tablo(i, 3) + tablo(i, 4) > 0 Then
        sh2.Range(sh2.Cells(LastRw2, "A"), sh2.Cells(LastRw2, "D")).Value = sh1.Range(sh1.Cells(i + 2, "A"), sh1.Cells(i + 2, "D")).Value
        LastRw2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
      End If
    Next i

Set sh1 = Nothing
Set sh2 = Nothing
End Sub