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,
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.