Runtime error 91 ? Need Help...
Bonjour,
J'essaye de developper une macro recopiant la collone +1 d'un intulé de ligne en la transposant sur la feuille suivante, ma boucle fonctionne, mais a la fin une erreur apparait.
Voici mon code :
Sub find_transpose()
' Variables
Dim What As String 'Valeur Cherché
Dim Frow As Long 'Ligne Valeur Trouve
Dim Last_row As Long 'Derniere ligne recherche
Dim l As Long 'ligne
Dim Lr As Long 'Last row sheet 2
'Recopie Vendor
l = 1
Last_row = Range("B1000000").End(xlUp).Row + 2
lastr = Range("B1000000").End(xlUp).Row
Sheets(1).Activate
'Vendor
For l = 1 To lastr
Sheets(1).Activate
Lr = 1 'Derniere ligne onglet 2
Sheets(1).Activate
What = "Vendor" 'Variante recherché
Sheets(1).Activate
Frow = Sheets(1).Range(Cells(l, 2), Cells(Last_row, 2)).find(What).Row 'Renvoi de la ligne
Cells(Frow, 3).Copy ' Copie de la cellule cherché
'Collage en derniere ligne
Sheets(2).Activate
Lr = Range("A1000000").End(xlUp).Row + 1
Cells(Lr, 1).PasteSpecial
Sheets(1).Activate
'Decalage d'une ligne
Lr = Lr + 1
l = Frow + 1
Next
End Sub
Merci par avance pour votre aide,
Cordialement.
J'essaye de developper une macro recopiant la collone +1 d'un intulé de ligne en la transposant sur la feuille suivante, ma boucle fonctionne, mais a la fin une erreur apparait.
Voici mon code :
Sub find_transpose()
' Variables
Dim What As String 'Valeur Cherché
Dim Frow As Long 'Ligne Valeur Trouve
Dim Last_row As Long 'Derniere ligne recherche
Dim l As Long 'ligne
Dim Lr As Long 'Last row sheet 2
'Recopie Vendor
l = 1
Last_row = Range("B1000000").End(xlUp).Row + 2
lastr = Range("B1000000").End(xlUp).Row
Sheets(1).Activate
'Vendor
For l = 1 To lastr
Sheets(1).Activate
Lr = 1 'Derniere ligne onglet 2
Sheets(1).Activate
What = "Vendor" 'Variante recherché
Sheets(1).Activate
Frow = Sheets(1).Range(Cells(l, 2), Cells(Last_row, 2)).find(What).Row 'Renvoi de la ligne
Cells(Frow, 3).Copy ' Copie de la cellule cherché
'Collage en derniere ligne
Sheets(2).Activate
Lr = Range("A1000000").End(xlUp).Row + 1
Cells(Lr, 1).PasteSpecial
Sheets(1).Activate
'Decalage d'une ligne
Lr = Lr + 1
l = Frow + 1
Next
End Sub
Merci par avance pour votre aide,
Cordialement.
3 réponses
-
Salut,
Je ne sais pas si l'erreur vient de là (pas testé) mais voilà ce que j'ai trouvé
For l = 1 To lastr
'...
'...
l = Frow + 1
Next
Dans ta boucle For, la variable de contrôle l est modifiée juste avant le Next.
C'est peut-être voulu, mais normalement on ne procède pas comme ça.
C'est le Next qui doit incrémenter la variable.
A+-
Salut,
En fait, j'ai fait ceci pour que la rechercherche reprenne seulement apres la premiere ligne trouvée.
J'ai essayé en supprimant, l'erreur subsiste.
Pour info l'erreur semble se situer dans ma variable Frow, car le debugger me surligne ceci :
Frow = Range(Cells(l, 2), Cells(Last_row, 2)).find(What).Row
Merci tout de meme.
PS : Mais excuses pour l'absence d'accent, je suis en clavier QWERTY...
-
-
Re,
Je crois que ton problème vient d'une d'une mauvaise utilisation de la méthode Find.
Essaie avec cette macro si ça va mieux
Sub find_transpose()
' Variables
Dim What As String 'Valeur Cherché
Dim Frow As Long 'Ligne Valeur Trouve
Dim Last_row As Long 'Derniere ligne recherche
Dim l As Long 'ligne
Dim Lr As Long 'Last row sheet 2
'Recopie Vendor
l = 1
Last_row = Range("B1000000").End(xlUp).Row + 2
lastr = Range("B1000000").End(xlUp).Row
Dim c, firstAddress
Sheets(1).Activate
'Vendor
What = "Vendor" 'Variante recherché
With Sheets(1).Range(Cells(l, 2), Cells(Last_row, 2))
Set c = .Find(What)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Frow = c.Row
Cells(Frow, 3).Copy ' Copie de la cellule cherché
'Collage en derniere ligne
Sheets(2).Activate
Lr = Range("A1000000").End(xlUp).Row + 1
Cells(Lr, 1).PasteSpecial
Sheets(1).Activate
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub -
ContributeurBonjour
What est un nom réservé...
... find(what:="vendor") ou what find("Vendor")
mais tu n'as pas besoin de lancer une boucle
si tu n'as qu'un "vendor"With Sheets(1)
If Application.CountIf(Columns("A"), "vendor") > 0 Then
Frow = Columns("A").Find("vendor", Range("A1"), xlValues).Row
Data = Cells(Frow, "C").Value
End If
End With
With Sheets(2)
lr = .Range("A1000000").End(xlUp).Row + 1
.Cells(lr, "A") = Data
End With
Si tu as plusieurs "vendor" à copier fais signe (on ne boucle que sur le nombre de "vendor"
je n'ai pas compris le pastespecial qui ne spécifie rien (format,valeur...) et j'ai supposé qu'il s'agissait de la valeur de la colonne C
Michel
