Microsoft 365 Copier lignes excel sous condition

[themyse1]

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

 

[Calvus]

Bonjour et bienvenue,

Ton code devrait fonctionner comme ceci :

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]

Bonjour et bienvenue,

Ton code devrait fonctionner comme ceci :

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]

Re,

If feuil.Cells(x, 8).Value
copiait la colonnes H.

Il fallait donc remplacer par :
If feuil.Cells(x, 26).Value
qui copie la colonne Z

A+

 

[themyse1]

Re,

If feuil.Cells(x, 8).Value
copiait la colonnes H.

Il fallait donc remplacer par :
If feuil.Cells(x, 26).Value
qui copie la colonne Z

A+

Merci, et je t’embête encire un peux 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.

 

[themyse1]

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

 

[Calvus]

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]

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]

Re,

A adapter

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]

Re,

A adapter

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.