Compiler informations plusieurs onglets si valeur cellule

Bonjour à tous,

Voilà je suis débutant en VBA et cela fait maintenant plusieurs jours que passe sur une formule qui n'arrive pas à sortir.

J'arrive actuellement à copier toutes les données (lignes) de mes différents onglets (les trois premiers) dans un onglet récapitulatif.

Cependant je n'arrive pas à intégrer une fonction "si valeur cellule L2 à Ln supérieur à 500" pour les "n" lignes des trois premiers onglets.

Voilà ce que j'ai actuellement,

Sub extraction()

Dim dlgR As Integer, dlgi As Integer
Dim i As Byte

    With Sheets("Extract") 'feuille récapitulative nettoyage
        dlgR = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A2:L" & dlgR).ClearContents
    End With

    For i = 1 To 3 'les 3 premiers onglets seulement pris en compte
        dlgR = Sheets("Extract").Range("A" & Rows.Count).End(xlUp).Row

        With Sheets(i) 'copier les données des 3 premiers onglets
            dlgi = .Range("A" & Rows.Count).End(xlUp).Row
            Range("A2:L" & dlgi).Copy Sheets("Extract").Range("A" & dlgR + 1)
        End With
    Next

End Sub

Voilà je vous remercie par avance pour votre aide.

Bonjour,

Si je comprends bien, la copie sera éffectuée si toutes les cellules L2 à Ln sont supérieures à 500.

Dans le cas contraire, on passe à la feuille suivante.

C'est bien cela ?

A+

Merci Grangy pour ta réponse.

En faite non, il faudrait que la macro copie toutes les lignes n qui ont la cellule Ln > 500 pour l'onglet 1, puis pour le 2 (à mettre à la suite des données relevées sur l'onglet 1), puis pour l'onglet 3.

Il faut que la macro analyse les pages les une après les autres. Actuellement c'est ce que ma macro fait, mais elle me copie toutes les données des 3 premiers onglets les une après les autres. Je n'arrive pas à ajouter la contrainte "copier ligne n si cellule Ln>500.

Merci

Essaie comme cela

Sub extraction()
Dim DlgR As Long, Dlgi As Long, Ligne As Long
Dim i As Byte
    With Sheets("Extract") 'feuille récapitulative nettoyage
        DlgR = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A2:L" & DlgR).ClearContents
    End With
    For i = 1 To 3 'les 3 premiers onglets seulement pris en compte
        DlgR = Sheets("Extract").Range("A" & Rows.Count).End(xlUp).Row
        With Sheets(i) 'copier les données des 3 premiers onglets
            Dlgi = .Range("A" & Rows.Count).End(xlUp).Row
            For Ligne = 2 To Dlgi
                If .Range("L" & Ligne).Value > 500 Then
                    .Range("A" & Ligne & ":L" & Ligne).Copy Sheets("Extract").Range("A" & DlgR + 1)
                    DlgR = DlgR + 1
                End If
            Next Ligne
        End With
    Next
End Sub

A+

Alors je viens d'essayer, mais j'ai une erreur d'incompatibilité sur la ligne où est indiqué la valeur recherchée:

Sub extraction()

Dim dlgR As Integer, dlgi As Integer
Dim i As Byte

    With Sheets("Extract") 'feuille récapitulative nettoyage
        dlgR = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A2:L" & dlgR).ClearContents
    End With

    For i = 1 To 3 'les 3 premiers onglets seulement pris en compte
        dlgR = Sheets("Extract").Range("A" & Rows.Count).End(xlUp).Row

        With Sheets(i) 'copier les données des 3 premiers onglets
            dlgi = .Range("A" & Rows.Count).End(xlUp).Row
                For Ligne = 2 To dlgi

                   If .Range("L" & Ligne).Value > "500" Then  'erreur incompatibilité

                        .Range("A" & Ligne & ":L" & Line).Copy Sheets("Extract").Range("A" & dlgR + 1)
                        dlgR = dlgR + 1
                    End If
                Next Ligne
        End With
    Next
End Sub

J'ai essayé d'ajouter les guillemets à 500 mais toujours pas.

Il faut que tu regardes la valeur de "Ligne" puis de .Range("L" & Ligne) lors de l'apparition de l'erreur.

Sinon, fais-moi passer le fichier (sans données confidentielles).

A+

Bonjour,

Voilà ci-joint le fichier Récap en question: http://xls.lu/34hL

Merci d'avance

Bonjour,

Plusieurs choses:

Dans mon code, il est écrit

.Range("A" & Ligne & ":L" & Ligne).Copy

Dans le tien, je lis

.Range("A" & Ligne & ":L" & Line).Copy

La valeur est bien numérique. Tu dois écrire 500 et non pas "500".

Par contre, je ne vois pas de valeur >500 dans la colonne L "Discount amount"

C'est bien la colonne a contrôler ?

A+

En effet j'ai mal repris le code.

C'est corrigé, j'ai mis 100 pour un test et ça fonctionne.

Seulement quand j'exécute la macro cela me supprime la ligne 1 (les titre des colonnes). Est-il possible de garder cette ligne?

Aussi est-il possible de délimiter les données par rapport à leur mois d'extraction? (saut de ligne ou inscrire le mois ou autre)

Enfin est-il possible d'accélérer la macro ou est-ce normal que cela mette un peu de temps?

Voilà le nouveau fichier mis à jour: http://xls.lu/Yuu5

Je te remercie d'avance pour ta patience frangy.

A bientôt.

Essaie comme cela

Sub extraction()
Dim DlgR As Long, Dlgi As Long, Ligne As Long
Dim i As Byte
    Application.Calculation = xlManual
    With Sheets("Extract") 'feuille r_capitulative nettoyage
        DlgR = .Range("A" & Rows.Count).End(xlUp).Row
        If DlgR = 1 Then DlgR = 2
        .Range("A2:L" & DlgR).ClearContents
    End With
    Application.ScreenUpdating = False
    For i = 1 To 3 'les 3 premiers onglets seulement pris en compte
        DlgR = Sheets("Extract").Range("A" & Rows.Count).End(xlUp).Row + 1
        With Sheets(i) 'copier les donn_es des 3 premiers onglets
            Dlgi = .Range("A" & Rows.Count).End(xlUp).Row
            For Ligne = 2 To Dlgi
                If .Range("L" & Ligne).Value > 100 Then  'erreur incompatibilit_
                    .Range("A" & Ligne & ":L" & Ligne).Copy Sheets("Extract").Range("A" & DlgR)
                    DlgR = DlgR + 1
                End If
            Next Ligne
        End With
    Next i
    MsgBox "You copied " & Ligne - 2 & " lines.", , "Processing complete"
    Application.Calculation = xlAutomatic
End Sub

A+

Parfait, je te remercie frangy.

Tout fonctionne parfaitement maintenant.

J'ai juste modifié au niveau de la suppression (supprimer la ligne pour ne plus avoir ni valeur ni format i.e. ligne de tableau) et le nombre de lignes copié (j'avais mis dlgi au lieu de dlgR).

Je poste le code final pour information:

Sub extraction()

Dim dlgR As Long, dlgi As Long, Ligne As Long
Dim i As Byte
    Application.Calculation = xlManual
    With Sheets("Extract") 'feuille recapitulative nettoyage
        dlgR = .Range("A" & Rows.Count).End(xlUp).Row
            If dlgR = 1 Then dlgR = 2
        .Range("A2:L" & dlgR).EntireRow.Delete
    End With

    Application.ScreenUpdating = False
    For i = 1 To 3 'les 3 premiers onglets seulement pris en compte
        dlgR = Sheets("Extract").Range("A" & Rows.Count).End(xlUp).Row + 1

        With Sheets(i) 'copier les donn_es des 3 premiers onglets
            dlgi = .Range("A" & Rows.Count).End(xlUp).Row
                For Ligne = 2 To dlgi
                    If .Range("L" & Ligne).Value > 100 Then
                        .Range("A" & Ligne & ":L" & Ligne).Copy Sheets("Extract").Range("A" & dlgR)
                        dlgR = dlgR + 1
                    End If
                Next Ligne
        End With
    Next i

    MsgBox "You copied " & dlgR - 2 & " lines.", , "Processing complete"
    Application.Calculation = xlAutomatic
End Sub

Encore merci frangy et à bientôt sur le forum.

Rechercher des sujets similaires à "compiler informations onglets valeur"