VBA Recherche qui ne Fct pas comme elle le doit

Ma Macro de recherche ne fonctionne hier apas comme je pense qu'elle aurait du le faire :

elle compte le nbr de fichier a chercher avec la feuille 2

si elle trouve dans le meme numero elle ecrit dans la feuille 2 que ça existes colonne AL mais elle n'ecris pas OK dans la feuil1 !!!!

Et elle ne copie pas ce qui ne matche pas non plus !!!!

Si vous pouviez me dire ou est mon erreur SVP ?

Fichier Zippé ici et code un peu plus bas

Sub EOL2()
Dim i As Integer
Dim j As Integer

On Error Resume Next
j = 1
For i = 2 To Worksheets("Feuil2").Cells(Rows.Count, "A").End(xlUp).Row
    Set adresse = Worksheets("Feuil1").[D:D].Find(What:=Worksheets("Feuil2").Cells(i, "A"), LookAt:=xlPart)
    If Not (adresse Is Nothing) Then
        Worksheets("Feuil1").Cells(i, "W") = "OK"
        Worksheets("Feuil2").Cells(i, "AL") = "Existes dans la feuille 2"
    Else
        Sheets("Feuil1").Rows(i).Copy
        Sheets("Feuil3").Rows(j).Paste
        j = j + 1
    End If
Next

End Sub

Bonjour,

Pour le collage ta syntaxe est incorrecte.

Sheets("Feuil1").Rows(i).Copy Sheets("Feuil3").Rows(j)

Cordialement.

ALors là en effet le copier fonctionne mais il n'ecrit pas Ok !!!!!! et je ne me l'expliques pas !!!!!

Mais j'ai quand meme bien l'impression que le résultat est faux

Le résultat est bien faux apres de nombreux essais.

Finalement j'ai trouvé ma soluce qui fonctionne parfaitement

j'ai même rajouté un lien hypertext pour vérifier plus facilement que le Ctrl F

@+

Sub query_USM()

Dim F1 As Range

Dim F2 As Range

Dim i As Integer

Dim j As Integer

Dim Dernligne2 As Long

Dim DernLigne1 As Long

DernLigne1 = Sheets("Feuil1").Range("D" & Rows.Count).End(xlUp).Row

Dernligne2 = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row

Set F1 = Sheets("Feuil1").Range("D2:D" & DernLigne1)

Set F2 = Sheets("Feuil2").Range("A2:A" & Dernligne2)

Application.ScreenUpdating = False

For i = 1 To F1.Rows.Count

For j = 1 To F2.Rows.Count

If F1(i, 1).Value = F2(j, 1).Value Then

F2(j, 38).Value = "Ok"

With Sheets("Feuil1")

.Hyperlinks.Add .Cells(i + 1, "W"), "", "'Feuil2'!A" & j + 1

F1(i, 20).Value = F2(j, 1)

'.Range("W" & i + 1).Value = Sheets("feuil2").Range("A" & j + 1).Value

End With

End If

Next j

Next i

Application.ScreenUpdating = True

Set F1 = Nothing

Set F2 = Nothing

End Sub

Bonjour,

Trop difficile à lire

Mais ceci :

    Set F1 = Nothing
    Set F2 = Nothing
End Sub

est complètement idiot.

Cordialement.

Un dernier petit coup de main s'il vous plait. Je ne m'en sort pas avec le lien hypertext qui pointe vers le second fichier je réussi a le créer mais il ne pointe pas la cellule et qui plus est il me met un message d'erreur comme quoi la référence n'est pas valide

si je crée le lien à la main cela marche et j'ai ça dans le lien : Test1.xls# 'Report 1'!A1

si quelqu'un à une idée.

Merci d'avance

Sub EOL()
Dim F1 As Range
Dim F2 As Range
Dim i As Integer
Dim j As Integer
Dim Dernligne2 As Long
Dim DernLigne1 As Long
Workbooks("test1.xls").Activate
DernLigne1 = Sheets("Report 1").Range("A" & Rows.Count).End(xlUp).Row
Workbooks("test2.xlsx").Activate
Dernligne2 = Sheets("Feuil1").Range("D" & Rows.Count).End(xlUp).Row

Set F1 = Workbooks("test1.xls").Sheets("Report 1").Range("A2:A" & DernLigne1)
Set F2 = Workbooks("test2.xlsx").Sheets("Feuil1").Range("D2:D" & Dernligne2)

Application.ScreenUpdating = False
For i = 1 To F2.Rows.Count
    For j = 1 To F1.Rows.Count
        If F2(i, 1).Value = F1(j, 1).Value Then
            F1(j, 38).Value = "Ok"
            F2(i, 20).Value = F1(j, 1)
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
                "Test1.xls", SubAddress:="Report 1!A" & j + 1
        End If
    Next j
Next i
Application.ScreenUpdating = True

End Sub

Essai de réécriture partielle:

Sub EOL()
    Dim F1 As Range
    Dim F2 As Range
    Dim i As Integer
    Dim j As Integer
    Dim Dernligne2 As Long
    Dim DernLigne1 As Long
    DernLigne1 = Workbooks("test1.xls").Sheets("Report 1").Range("A" & Rows.Count) _
     .End(xlUp).Row
    Dernligne2 = Workbooks("test2.xlsx").Sheets("Feuil1").Range("D" & Rows.Count) _
     .End(xlUp).Row
    Set F1 = Workbooks("test1.xls").Sheets("Report 1").Range("A2:A" & DernLigne1)
    Set F2 = Workbooks("test2.xlsx").Sheets("Feuil1").Range("D2:D" & Dernligne2)
    Application.ScreenUpdating = False
    For i = 1 To F2.Rows.Count
        For j = 1 To F1.Rows.Count
            If F2(i, 1).Value = F1(j, 1).Value Then
                F1(j, 38).Value = "Ok"
                F2(i, 20).Value = F1(j, 1)
                Workbooks("test2.xlsx").Sheets("Feuil1").Hyperlinks.Add Anchor:= _
                 F2(i, 20), Address:="Test1.xls", SubAddress:="Report 1!A" & j + 1
            End If
        Next j
    Next i
    Application.ScreenUpdating = True
End Sub

Sous réserve. A force de jouer avec des Activate et Select on s'y perd. Et on ne sait même pas dans quel classeur se trouve la macro...

Cordialement.

Re, Mr Ferrand merci pour la ré-écriture,

j'ai re-essayé de simplifier car en effet je me rends compte que c'est le bazar, qu'autant c'est presque clair dans mes petites neurones mais que cela ne l'est pas forcément pour vous.

votre façon de créer le lien hypertext me génère une erreur et ne pointe pas sur la bonne cellule si je clique dessus par contre avant de cliquer juste en promenant la souris elle pointe bien la bonne case dans le bon fichier !!!!

Tant qu'à savoir ou est ma macro elle est dans personal .xlsb

je viens d'essayer de copier test1.xls en test1xlsx et ça me fais exactement pareil.

Je vous mets les 2 fichiers en version light des fois que vous ayez la folle idée de me venir en aide encore plus.

Cordialement,

Sub EOL()
Dim F1 As Range
Dim F2 As Range
Dim i As Integer
Dim j As Integer
Dim Dernligne2 As Long
Dim DernLigne1 As Long
Dim T1 As Workbook
Dim T2 As Workbook
Dim T1F As Worksheet
Dim T2F As Worksheet

Set T1 = Workbooks("Test1.xlsx")
Set T2 = Workbooks("Test2.xlsx")
Set T1F = Workbooks("Test1.xlsx").Sheets("Report 1")
Set T2F = Workbooks("Test2.xlsx").Sheets("Feuil1")

Dernligne2 = T2F.Range("D" & Rows.Count) _
     .End(xlUp).Row
DernLigne1 = T1F.Range("A" & Rows.Count) _
     .End(xlUp).Row

Set F1 = T1F.Range("A2:A" & DernLigne1)
Set F2 = T2F.Range("D2:D" & Dernligne2)

Application.ScreenUpdating = False
For i = 1 To F2.Rows.Count
    For j = 1 To F1.Rows.Count
        If F2(i, 1).Value = F1(j, 1).Value Then
            F1(j, 38).Value = "Ok"
            F2(i, 20).Value = F1(j, 1)
            Workbooks("test2.xlsx").Sheets("Feuil1").Hyperlinks.Add Anchor:= _
                 F2(i, 20), Address:="Test1.xlsx", SubAddress:="Report 1!A" & j + 1
           ' T2F.Hyperlinks.Add Anchor:= _
           ' F2(i, 20), Address:=T1, SubAddress:=T1F!A & j + 1
        End If
    Next j
Next i
Application.ScreenUpdating = True

End Sub

Youpi,

ça marche merci beaucoup Mr Ferrand !!!!!

Mais la dernière coquille dans le code je l'ai trouvé tout seul comme un grand comme quoi tout arrive !!!!!

il manquait l'apostrophe de part et d'autre de "'Report 1'!A"& j + 1

 T2F.Hyperlinks.Add Anchor:= _
                 F2(i, 20), Address:="Test1.xlsx", SubAddress:="'Report 1'!A" & j + 1

Désolé, je n'avais pas regardé les détails de l'adresse...

J'avais essayé de traduire la sélection que tu ne faisais pas. Cela montre bien en tout cas qu'il vaut mieux qualifier ses objets.

Bonne continuation.