Microsoft 365 Copier lignes excel sous condition

themyse1

XLDnaute Nouveau
Bonjour,

j'au une extraction de on logiciel métier d'un fichier très volumineux qui est agrémenté automatiquement. j'aimerais copier exclusivement les ligne qui me concernent de ce fichier vers un autre classeur Excel.

je me suis inspiré du code que j'ai trouvé sur ce forum mais il doit y avoir un truc que je fait mal parce que ça ne fonctionne pas.
Dans mon classeur d'exemple j'aimerais copier toutes les lignes qui concernent Toto.

Merci de votre aide
 

Pièces jointes

  • Toto.xlsm
    20.9 KB · Affichages: 11

Calvus

XLDnaute Barbatruc
Bonjour et bienvenue,

Ton code devrait fonctionner comme ceci :
VB:
Sub extract()
    Dim feuil As Worksheet
    Dim nbLignes As Integer
    ' récupération nombre lignes non vides (en se basant sur la colonne Z)
    ' dans la page Resultat pour extraire à partir de la ligne suivante
    nbLignes = Sheets("Resulta").Range("Z20").End(xlUp).Row
  
    Dim lastLigneFeuil As Integer
    Dim plageCellules As Range
    Dim trig As Integer
    trig = 0
  
    ' boucle sur chaque feuille du classeur hors mis la feuille Base
    For Each feuil In ThisWorkbook.Sheets
        If Not feuil.Name = "Resultat" Then
            ' récupération de la dernière ligne non vide de la feuille scannée (en se basant sur la colonne Z)
            lastLigneFeuil = feuil.Range("Z20").End(xlUp).Row

            ' boucle allant de 1 jusqu'à la dernière ligne non vide de la feuille scannée
            For x = 1 To lastLigneFeuil
                ' si la cellule en Z1 ... Zx contient la valeur "Toto"
                ' alors on copie la ligne entière dans la prochaine ligne vide de la page Resulta
                If feuil.Cells(x, 26).Value = "Toto" Then
                    feuil.Cells(x, 26).EntireRow.Copy Destination:=Sheets("Resulta").Cells(nbLignes + 1, 1).Offset(trig, 0).EntireRow
                    trig = trig + 1
                End If
            Next
        End If
    Next feuil

End Sub

A+
 

themyse1

XLDnaute Nouveau
Bonjour et bienvenue,

Ton code devrait fonctionner comme ceci :
VB:
Sub extract()
    Dim feuil As Worksheet
    Dim nbLignes As Integer
    ' récupération nombre lignes non vides (en se basant sur la colonne Z)
    ' dans la page Resultat pour extraire à partir de la ligne suivante
    nbLignes = Sheets("Resulta").Range("Z20").End(xlUp).Row
 
    Dim lastLigneFeuil As Integer
    Dim plageCellules As Range
    Dim trig As Integer
    trig = 0
 
    ' boucle sur chaque feuille du classeur hors mis la feuille Base
    For Each feuil In ThisWorkbook.Sheets
        If Not feuil.Name = "Resultat" Then
            ' récupération de la dernière ligne non vide de la feuille scannée (en se basant sur la colonne Z)
            lastLigneFeuil = feuil.Range("Z20").End(xlUp).Row

            ' boucle allant de 1 jusqu'à la dernière ligne non vide de la feuille scannée
            For x = 1 To lastLigneFeuil
                ' si la cellule en Z1 ... Zx contient la valeur "Toto"
                ' alors on copie la ligne entière dans la prochaine ligne vide de la page Resulta
                If feuil.Cells(x, 26).Value = "Toto" Then
                    feuil.Cells(x, 26).EntireRow.Copy Destination:=Sheets("Resulta").Cells(nbLignes + 1, 1).Offset(trig, 0).EntireRow
                    trig = trig + 1
                End If
            Next
        End If
    Next feuil

End Sub

A+
merci @Calvus , mais qu'est ce qui n'allait pas dans mon code ?
 

Calvus

XLDnaute Barbatruc
Re,
pourquoi il me copie en double, je me retrouve avec 8 "TOTO" alors que je n'en ai sue 4 sur la feuille d'origine.

Je n'avais pas fait attention à ça.
Ton code parle de la feuille "Resultat" alors que ta feuille est nommée "Resulta"

Modifier donc soit le code soit le nom de la feuille.

et autre chose si mes 2 fichiers sont des classeur différents, ça fonctionne aussi ou il faut changer quelque chose?

Non, il faudra boucler sur les 2 classeurs.
 

themyse1

XLDnaute Nouveau
Re,


Je n'avais pas fait attention à ça.
Ton code parle de la feuille "Resultat" alors que ta feuille est nommée "Resulta"

Modifier donc soit le code soit le nom de la feuille.



Non, il faudra boucler sur les 2 classeurs.
Merci de ton temps, comment je fais pour boucler sur les 2 classeurs.
parce que les fichier volumineux arrive sur le réseaux accessible à tous, et moi j'aimerais pouvoir en extraire mes donné vers mon "C"
 

Calvus

XLDnaute Barbatruc
Re,

A adapter
VB:
Sub Ouvrir() 'Ouverture du fichier téléchargé
 Dim fichier As Variant
ChDir "C:\Users\Le chemin du fichier"
Fichier = Application.GetOpenFilename("Classeurs Excel(*.xls),*.xls, Macros complémentaires (*.xla),*.xla")
 Workbooks.Open fichier
'Faire la boucle ou importer...
ActiveWorkbook.Close (False)
ETC...
End Sub

A+
 

themyse1

XLDnaute Nouveau
Re,

A adapter
VB:
Sub Ouvrir() 'Ouverture du fichier téléchargé
Dim fichier As Variant
ChDir "C:\Users\Le chemin du fichier"
Fichier = Application.GetOpenFilename("Classeurs Excel(*.xls),*.xls, Macros complémentaires (*.xla),*.xla")
Workbooks.Open fichier
'Faire la boucle ou importer...
ActiveWorkbook.Close (False)
ETC...
End Sub

A+
Merci beaucoup, de ton retour, je vais la tester de suite.
 

Discussions similaires

Réponses
10
Affichages
183
Réponses
9
Affichages
380

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo