Copier les lignes qui contiennent "MOT 1" ou " MOT 2"

Le 05/12/2013 à 16:45

Bonjour ,

je souhaite chercher dasn la colonne H les cellules qui contiennent "http" ou "https" puis les copier leurs lignes dans une autre feuille , voir le code ci dessous ,

'Partie les lignes serveurs
Set wst = Workbooks("gestion.xls").Worksheets("Tableau_Proxy")
For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1
derlignes = wb.Sheets("2. Servers").Range("A" & Rows.Count).End(xlUp).Row

'on recherche la première ligne contenant "http"
Set re = wb.Sheets("2. Servers").Range("H:H" & derlignes).Find("http", lookat:=xlPart)
If Not re Is Nothing Then
wb.Sheets("2. Servers").Range("B" & re.Row & ":V" & derlignes).Copy wst.Range("A" & derlignee)
End If

le souci avec ce code c'est qu'il cherche "http" mais dés qu'il la trouve il copie toutes les autres lignes qui sont après !

Merci pour votre aide.

Le 05/12/2013 à 17:27

Bonjour,

Pour copier simplement les cellules de la plage comprise entre les colonnes B et V, tu peux utiliser

wb.Sheets("2. Servers").Range("B" & re.Row & ":V" & re.Row).Copy wst.Range("A" & derlignee)

Par contre, je remarque que ton code effectue la copie d’une seule ligne. Après avoir trouvé le texte "http", il passe au classeur suivant. Il ne fait donc pas la copie de toutes les lignes qui contiennent "http".

Difficile d’en dire plus avec un code tronqué et sans exemple.

A+

Le 05/12/2013 à 17:52

merci bien , maintenant au moins il copie que la première ligne qui contient "http" , mais il s’arrête ici ! il ne continue pas à tester les autre ligne qui suivent , je pense qu'il faut une boucle ?

Le 05/12/2013 à 18:14

j'ai trouver quelque chose d'utile je pense mais je n'arrive pas à l'interpréter à mon cas :

un exemple :

With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
Le 05/12/2013 à 19:47

maintenant au moins il copie que la première ligne qui contient "http" , mais il s’arrête ici ! il ne continue pas à tester les autre ligne qui suivent , je pense qu'il faut une boucle ?

Tu penses bien.

Dommage que tu ne prennes pas en compte les observations

Difficile d’en dire plus avec un code tronqué et sans exemple.

Comme je suis dans mon jour de bonté, je veux bien faire un effort 

    'Partie les lignes serveurs
    Set wst = Workbooks("gestion.xls").Worksheets("Tableau_Proxy")
    For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
    If UCase(wb.Name) <> UCase("gestion.xls") Then
        derlignee = wst.Range("A65536").End(xlUp).Row + 1
        derlignes = wb.Sheets("2. Servers").Range("A" & Rows.Count).End(xlUp).Row

        'on recherche les lignes contenant "http"
        With wb.Sheets("2. Servers")
            Set re = wb.Sheets("2. Servers").Range("H1:H" & derlignes).Find("http", lookat:=xlPart)
            If Not re Is Nothing Then
                firstAddress = re.Address
                Do
                    wb.Sheets("2. Servers").Range("B" & re.Row & ":V" & re.Row).Copy wst.Range("A" & derlignee)
                    derlignee = derlignee + 1
                    Set re = .Range("H1:H" & derlignes).FindNext(re)
                Loop While Not re Is Nothing And re.Address <> firstAddress
            End If
        End With
    End If

A+

Le 06/12/2013 à 12:07

Bonjour,

Comme je suis dans mon jour de bonté, je veux bien faire un effort

ouiii vraiment c un grand jour de bonté pour toi et ton effort est bien là et bien exploité Merci bien !

mais quand j'essaie d'ajouter "https" pour qu'il puisse chercher "http" ou "https" le code ci dessous n'est pas reconnue :

 Set re = wb.Sheets("2. Servers").Range("H1:H" & derlignes).Find("http","https", lookat:=xlPart)

aussi celà ne fonctionne pas il prend en compte juste "https":

'Partie les lignes serveurs
   Set wst = Workbooks("gestion.xls").Worksheets("Tableau_Proxy")
    For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
   If UCase(wb.Name) <> UCase("gestion.xls") Then
        derlignee = wst.Range("A65536").End(xlUp).Row + 1
        derlignes = wb.Sheets("2. Servers").Range("A" & Rows.Count).End(xlUp).Row

        'on recherche les lignes contenant "http et https"
        With wb.Sheets("2. Servers")
            Set re = wb.Sheets("2. Servers").Range("H1:H" & derlignes).Find("http", lookat:=xlPart)
            Set re1 = wb.Sheets("2. Servers").Range("H1:H" & derlignes).Find("https", lookat:=xlPart)
            If Not re Is Nothing Then
                firstAddress = re.Address
             If Not re1 Is Nothing Then
             firstAddress = re1.Address
                Do
                    wb.Sheets("2. Servers").Range("B" & re.Row & ":V" & re.Row).Copy wst.Range("A" & derlignee)
                    wb.Sheets("2. Servers").Range("B" & re1.Row & ":V" & re1.Row).Copy wst.Range("A" & derlignee)
                    derlignee = derlignee + 1
                    Set re = .Range("H1:H" & derlignes).FindNext(re)
                    Set re1 = .Range("H1:H" & derlignes).FindNext(re1)
                Loop While Not re Is Nothing And re.Address <> firstAddress And re1.Address <> firstAddress
            End If
            End If
        End With
    End If
Next

comment avoir le résultat des deux ! Merci

Le 06/12/2013 à 12:24

et quand je fais complètement ça :

  'Partie les lignes serveurs
   Set wst = Workbooks("gestion.xls").Worksheets("Tableau_Proxy")
    For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
   If UCase(wb.Name) <> UCase("gestion.xls") Then
        derlignee = wst.Range("A65536").End(xlUp).Row + 1
        derlignes = wb.Sheets("2. Servers").Range("A" & Rows.Count).End(xlUp).Row
                'on recherche les lignes contenant "http"

        With wb.Sheets("2. Servers")
            Set re = wb.Sheets("2. Servers").Range("H1:H" & derlignes).Find("http", lookat:=xlPart)
            If Not re Is Nothing Then
                firstAddress = re.Address
                Do
                    wb.Sheets("2. Servers").Range("B" & re.Row & ":V" & re.Row).Copy wst.Range("A" & derlignee)
                    derlignee = derlignee + 1
                    Set re = .Range("H1:H" & derlignes).FindNext(re)
                Loop While Not re Is Nothing And re.Address <> firstAddress
            End If
        End With

        'on recherche les lignes contenant "https"
        With wb.Sheets("2. Servers")
            Set re1 = wb.Sheets("2. Servers").Range("H1:H" & derlignes).Find("https", lookat:=xlPart)
            If Not re1 Is Nothing Then
                firstAddress = re1.Address
                Do
                    wb.Sheets("2. Servers").Range("B" & re1.Row & ":V" & re1.Row).Copy wst.Range("A" & derlignee)
                    derlignee = derlignee + 1
                    Set re1 = .Range("H1:H" & derlignes).FindNext(re1)
                Loop While Not re1 Is Nothing And re1.Address <> firstAddress
            End If
        End With

    End If

Next

ça donne un résultat mais avec répétition ,???

Le 06/12/2013 à 13:08

c'est du n'importe quoi dsl les membres ; Si on utilise xlPart avec une recherche sur HTTP, ça devrait ressortir les HTTPS en même temps... Merci

Le 06/12/2013 à 13:32

maintenant quand je souhaite le résultat contraire : toute les lignes qui ne contiennent pas ( "http" ou "https") , j'ai mis ce code , mais ça donne un résultat vide !

'Partie les lignes serveurs
   Set wst = Workbooks("gestion.xls").Worksheets("Tableau_Proxy")
   For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
   If UCase(wb.Name) <> UCase("gestion.xls") Then
   derlignee = wst.Range("A65536").End(xlUp).Row + 1
   derlignes = wb.Sheets("2. Servers").Range("A" & Rows.Count).End(xlUp).Row

        'on recherche les lignes contenant "http et https"
        With wb.Sheets("2. Servers")
        Set re = wb.Sheets("2. Servers").Range("H1:H" & derlignes).Find("http", lookat:=xlPart)
        If re Is Nothing Then
        firstAddress = re.Address
        Do
        wb.Sheets("2. Servers").Range("B" & re.Row & ":V" & re.Row).Copy wst.Range("A" & derlignee)
        derlignee = derlignee + 1
        Set re = .Range("H1:H" & derlignes).FindNext(re)
        Loop While  re Is Nothing And re.Address <> firstAddress
        End If
        End With
        End If
        Next
Le 06/12/2013 à 13:34

Bonjour,

Essaie comme cela

    'Partie les lignes serveurs
    Set wst = Workbooks("gestion.xls").Worksheets("Tableau_Proxy")
    For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
        If UCase(wb.Name) <> UCase("gestion.xls") Then
            derlignee = wst.Range("A65536").End(xlUp).Row + 1
            derlignes = wb.Sheets("2. Servers").Range("A" & Rows.Count).End(xlUp).Row
            'on recherche les lignes contenant "http" et "https"
            With wb.Sheets("2. Servers")
               Set re = .Range("H1:H" & derlignes).Find(What:="http*", After:=.Range("H" & derlignes), LookIn:=xlValues, LookAt:= _
                   xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                   , SearchFormat:=False)
                If Not re Is Nothing Then
                    firstAddress = re.Address
                    Do
                        .Range("B" & re.Row & ":V" & re.Row).Copy wst.Range("A" & derlignee)
                        derlignee = derlignee + 1
                        Set re = .Range("H1:H" & derlignes).FindNext(re)
                    Loop While Not re Is Nothing And re.Address <> firstAddress
                End If
            End With
        End If

A+

Le 06/12/2013 à 15:24

ça donne le même résultat qu'avant , il cherche les "http" et les "https" et "http..." , maintenant je cherche le contraire je pense que tu n'as pas lit les messages précédents ! Merci

Le 07/12/2013 à 10:31

ça donne le même résultat qu'avant , il cherche les "http" et les "https" et "http..." , maintenant je cherche le contraire je pense que tu n'as pas lit les messages précédents !

Il faut dire que tu es difficile à suivre. Tu parviens à poster 4 messages d’affilée sans attendre les réponses.

As-tu envisagé de te poser ? Tu souhaites maintenant faire le contraire de ta demande initiale. En attendant un peu, on devrait en revenir au contraire du contraire .

Bon, tu as déjà résolu 3 problèmes :

  • Copier une ligne qui contient "http" sans copier toutes les lignes suivantes.
  • Copier toutes les lignes qui contiennent "http"
  • Copier toutes les lignes qui contiennent "http" ou "https"
Par contre, pour chercher les lignes qui ne contiennent pas "http" ou "https", tu as intérêt à oublier la fonction Find. Tu peux par exemple utiliser un filtre automatique avec un critère "<>*http*"

Si tu souhaites aller plus loin, fais passer un classeur pour exemple.

A+

Le 11/12/2013 à 18:09

Bonjour,

qu'est ce que vous pensez de ça ??

Sub ACL_Servers_Lines()

Dim ret As Integer
ret = MsgBox("Souhaitez-Vous toutes les Lignes (Servers) ?", vbYesNo, " ATOS / RENAULT (EIS) ")
If ret = vbNo Then
Exit Sub
Else

' wst = feuille tableau du classeur gestion

Set wst = Workbooks("gestion.xls").Worksheets("Tableau_ACL")
derligne = wst.Range("A65536").End(xlUp).Row + 1
Sheets("Tableau_ACL").Activate
Cells(derligne, 1) = Range("dt").Value
Cells(derligne, 2) = Range("demandeur").Value
Cells(derligne, 3) = Range("adresse").Value
Cells(derligne, 4) = Range("Statut").Value
Cells(derligne, 5) = Range("CDS").Value

 Range("demandeur").Value = ""
 Range("adresse").Value = ""
 Range("Statut").Value = ""
 Range("CDS").Value = ""

 'Partie les lignes serveurs

For Each wb In Workbooks 'on parcourt tous les classeurs ouverts
If UCase(wb.Name) <> UCase("gestion.xls") Then
derlignee = wst.Range("A65536").End(xlUp).Row + 1
wb.Sheets("2. Servers").Range("B6:V100").Copy wst.Range("A" & derlignee)
End If
Next
End If
'supprimmer les lignes contenent "http"
For i = dernligne To 1 Step -1
If Workbooks("gestion.xls").Worksheets("Tableau_ACL").Cells(i, 7) = "http" Then
Workbooks("gestion.xls").Worksheets("Tableau_ACL").Cells(i, 7).EntireRow.Delete
End If
Next i
End Sub

Merci

Le 11/12/2013 à 19:39

Bonjour,

As-tu testé ton code ?

De mon coté, je ne peux pas le faire puisque tu n'as toujours pas joint un fichier exemple .

Je crois comprendre que tu ne cherches plus à détecter les lignes qui ne contiennent pas "http" ou "https" mais que tu souhaites radicalement supprimer les lignes qui contiennent "http" ou "https".

Effectivement, après suppression, il devrait rester les lignes sans "http" ou "https".

Pour le test, j'aurais mieux vu

If Workbooks("gestion.xls").Worksheets("Tableau_ACL").Cells(i, 7) like "*http*" Then

A+

Le 13/12/2013 à 17:12

Oui bien sur le mieux est :

 If Workbooks("gestion.xls").Worksheets("Tableau_ACL").Cells(i, 7) like "*http*" Then

Par contre quand j’exécute le Macro ce qui est entre la dernière boucle 'For' ne s'exécute pas ! le résultat ne prend pas en considération les instructions !

j'ai utilisé F8 pour voir ce qui ce passe , après que le curseur arrive à For il saute directement à End Sub ?

Merci pour votre aide

Le 13/12/2013 à 17:32

j'ai lui isolé complétement du Macro mére en luis isolant tout seul :

et enfin un résultat raisonnable lol ^^ par contre il ne prend pas compte HTTP en Majuscule !

Sub supphttp()
'supprimmer http
Set wst = Workbooks("gestion.xls").Worksheets("Tableau_ACL")
derligne = wst.Range("A65536").End(xlUp).Row + 1
Sheets("Tableau_ACL").Activate
For i = derligne To 1 Step -1
If Workbooks("gestion.xls").Worksheets("Tableau_ACL").Cells(i, 7) Like "*http*" Then
Workbooks("gestion.xls").Worksheets("Tableau_ACL").Cells(i, 7).EntireRow.Delete
End If
Next i
End Sub
Le 13/12/2013 à 17:50

c bon tous fonctionne bien ! merci à tous

Rechercher des sujets similaires à "copier lignes qui contiennent mot"