Copie de lignes sous condition

Bonjour à tous,

Dans un classeur Excel, j'ai 2 onglets(Base1 et Base2) dont les données provient d'une base externe, mis à jour quotidiennement.

Elles possèdent toutes les 2 des colonnes identiques de A à F,

La colonne F donne un calcul de résultat en fonction des données dans les autres colonnes.

Je souhaiterai si possible copier et coller dans l'onglet Résultat automatiquement les lignes des colonnes A:F des onglets Base1 et Base2 dont le résultat est supérieur à 0.

Ci-joint un extrait pour exemple.

Merci par avance pour aide

Bonsoir,

Je te propose en annexe une solution pour ton problème.

Cette technique, une fois maîtrisée, peut être utilisée pour plusieurs cas de figure où il faut ramener des lignes d'un tableau répondant à un ou plusieurs critères.

J'ai joint un Mode d'emploi et un Comment cela marche.

Si questions n'hésites à me revenir

Merci de confirmer si cela répond à tes attentes.

Bon courage

Chris

Bonjour

Une proposition VBA, sans aucune limite de taille des Base 1 et 2

Public tabBase()
Public tabResult()

Public wsBase As Object
Public wsResult As Object

Sub Copier()
Dim cptOnglet
Dim cptDonnees, colDonnees
Dim cptResulte
Dim ligFin

    cptResulte = 0

    Set wsResult = Worksheets("Resultat")
    For cptOnglet = 1 To 2

        Set wsBase = Worksheets("Base" & cptOnglet)
        With wsBase
            tabBase = Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 6))
        End With

        For cptDonnees = 1 To UBound(tabBase, 1)
            If tabBase(cptDonnees, 6) > 0 Then
                cptResulte = cptResulte + 1
                ReDim Preserve tabResult(1 To UBound(tabBase, 2), 1 To cptResulte)
                For colDonnees = 1 To UBound(tabBase, 2)
                    tabResult(colDonnees, cptResulte) = tabBase(cptDonnees, colDonnees)
                Next
            End If
        Next

        Set wsBase = Nothing

    Next

    With wsResult
        ligFin = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(ligFin, 1).Resize(UBound(tabResult, 1), UBound(tabResult, 2)) = WorksheetFunction.Transpose(tabResult)
    End With

    Set wsResult = Nothing

End Sub

Bonjour à toutes et tous,

Une autre proposition par VBA.

Cliquer sur un des boutons "Go"

Cordialement.

Bonjour,

Merci à tous pour vos réponses et les explications détaillées , les 3 marchent sur mon fichier

Merci encore!

Bonjour Thierry31, le fil

Thierry31 a écrit :

Merci à tous pour vos réponses et les explications détaillées , les 3 marchent sur mon fichier

PS/ Sans indiscrétion laquelle intégreras-tu ? tu ne vas tout de même pas installer les 3 en souvenir