Aide pour modification macro existante

[megansport]

Bonjour
Voici ma macro ci dessous, elle me permet de faire une recherche en fonction d'une référence numérique mais je dois la modifier car j'ai de nouvelles références avec des lettres et des chiffres ( par exemple AR107)
Elle devra me servir pour extraire les références numériques et alpha-numériques
Voici la macro

Public Sub extraction()
Dim DerL As Long, L As Long, Li As Long, Cel As Range

Application.ScreenUpdating = False

Worksheets("feuil3").Cells.Clear

With Worksheets("nomsphotos")
liste = .Range("A1:A" & .Range("A1000").End(xlUp).Row)
End With
For L = 1 To UBound(liste, 1)
liste(L, 1) = Mid(liste(L, 1), InStr(liste(L, 1), "_") + 1)

Next

With Worksheets("bdd")
DerL = .Range("A1000").End(xlUp).Row
For L = 1 To UBound(liste, 1)
Set Cel = .Columns(1).Find(CDbl(liste(L, 1)), LookIn:=xlValues, LookAt:=xlWhole)
If Not Cel Is Nothing Then
Li = Worksheets("feuil3").Range("A1000").End(xlUp).Row + 1
.Range("A" & Cel.Row & ":M" & Cel.Row).Copy Destination:=Worksheets("feuil3").Range("A" & Li)
End If
Next
End With

Worksheets("feuil3").UsedRange.Columns.AutoFit

Application.ScreenUpdating = True

End Sub


Merci de votre aide

 

[Robert]

Re : Aide pour modification macro existante

Bonsoir Megansport, bonsoir le forum,

Voilà ce que je te propose. Tu prends ton fichier et tu le jettes... Ensuite avec le code que tu nous a donné et un fichier vierge, tu essaies de faire avancer la macro pas à pas pour comprendre comment elle fonctionne. Ha c'est ch...t hein ! Il faut renommer les onglet sinon ça plante. Et puis il faut des données qui conviennent sinon le code plante...
Tu l'auras compris, ce que je voudrais te faire comprendre, de façon un peu abrupte j'en conviens, c'est que sans fichier exemple il nous est difficile de te venir en aide. Alos fait toi aussi un petit effort et les choses iront beaucoup plus vite.

 

[Bebere]

Re : Aide pour modification macro existante

bonjour megansport
à tester

For L = 1 To UBound(liste, 1)
if isnumeric(liste(L, 1)) then x=CDbl(liste(L, 1)) else  x=liste(L, 1)
Set Cel = .Columns(1).Find(x), LookIn:=xlValues, LookAt:=xlWhole)

 

[megansport]

Re : Aide pour modification macro existante

Bonsoir
Voici le fichier, j'ai essayer le code mais cela ne marche pas
Merci de votre aide

 

[Robert]

Re : Aide pour modification macro existante

Bonsoir le fil, bonsoir le forum,

Tu aurais dû tester la proposition de Bebere car elle fonctionne. Sinon une autre option, remplacer CDbl par CStr.

Public Sub extraction()
Dim DerL As Long, L As Long, Li As Long, Cel As Range

Application.ScreenUpdating = False
Worksheets("feuil3").Cells.Clear
With Worksheets("nomsphotos")
    liste = .Range("A1:A" & .Range("A1000").End(xlUp).Row)
End With
For L = 1 To UBound(liste, 1)
    liste(L, 1) = Mid(liste(L, 1), InStr(liste(L, 1), "_") + 1)
Next
With Worksheets("bdd")
    DerL = .Range("A1000").End(xlUp).Row
    For L = 1 To UBound(liste, 1)
        Set Cel = .Columns(1).Find(CStr(liste(L, 1)), LookIn:=xlValues, LookAt:=xlWhole)
        If Not Cel Is Nothing Then
            Li = Worksheets("feuil3").Range("A1000").End(xlUp).Row + 1
            .Range("A" & Cel.Row & ":M" & Cel.Row).Copy Destination:=Worksheets("feuil3").Range("A" & Li)
        End If
    Next
End With
Worksheets("feuil3").UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
End Sub