Microsoft 365 Coller directement mon N° cherché, APRES formatage dans "InputBox"

[Usine à gaz]

Bonjour à toutes et à tous

J'essaie, comme dit en titre de "Coller directement mon N° cherché, après formatage dans "InputBox""
J'ai tenté encore cette nuit, j'ai fait des recherches sans succès.
Alors, une fois encore, je me tourne vers nos ténors magiques

L'action :
Nous copions des n° sous diverses formes et généralement comme saisis de B6 à B10
Le but est formater le n° comme ceux saisis de de B6 à B10

Ce que je sais faire :
Je fais le formatage et ma recherche - tout fonctionne sans souci
1 - de B6 à B10 : sélection du n° à copier à partir de la barre de formule (pour "imiter" la copie sur un site ou autres sources)
2 - Clic sur "Prépa"; le code met le n° en forme dans "G2" (suppression des espaces et du 0 à gauche s'il existe)
3 - Copie du N° "G2" : sélection dans la barre de formule
4 - Clic sur "Trouve" et collage dans "InputBox".
5 - ok pour recherche

Ce que je voudrais :
Ma réflexion (toujours dans le but d'économiser des clics et pour gains de temps)
Je pense que les 4 opérations pourraient être faites en 1 seul clic :
Mais je ne sais pas coller directement mon N° cherché, avant formatage, le formatage se fait et il se met formaté dans "InputBox"

Je n'y arrive pas. Pourriez-vous m'aider ?
En cas, je joins le fichier test.
Un grand merci à tous,
lionel

 

[job75]

Plutôt que ta macro il est plus simple d'utiliser la boîte de dialogue Rechercher (Ctrl+F), fichier (3) :

Sub Trouve()
Dim v, w As Worksheet
Application.ScreenUpdating = False
On Error Resume Next
Workbooks.Add 'nouveau document
ActiveSheet.Paste 'colle ce qui est dans le presse-papiers
v = Val(Replace([a1], " ", ""))
ActiveWorkbook.Close False
On Error GoTo 0
v = 33 & v
For Each w In Worksheets
    w.Cells.FormatConditions.Delete 'RAZ
    If v <> "330" Then
        w.UsedRange.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=" & v
        w.UsedRange.FormatConditions(1).Interior.ColorIndex = 44 'orange
    End If
Next
Application.ScreenUpdating = True
If v <> "330" Then CreateObject("wscript.shell").SendKeys "^f" & v 'envoi de touches sur la boîte de dialogue Rechercher
End Sub

 

[job75]

J'aimerais juste que la mfc soit annulée après qu'il ait trouvé... Je pense pouvoir faire ça lol

Allons allons, dans ce cas la MFC est inutile !

 

[job75]

Bonjour Lionel, le forum,

Fichier (4) avec un UserForm et une ListBox :

Sub Trouve()
Dim v, w As Worksheet, c As Range
Application.ScreenUpdating = False
On Error Resume Next
Workbooks.Add 'nouveau document
ActiveSheet.Paste 'colle ce qui est dans le presse-papiers
v = Val(Replace([a1], " ", ""))
ActiveWorkbook.Close False
On Error GoTo 0
v = 33 & v
For Each w In Worksheets
    w.Cells.FormatConditions.Delete 'RAZ
    If v <> "330" Then
        w.UsedRange.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=" & v
        w.UsedRange.FormatConditions(1).Interior.ColorIndex = 44 'orange
        For Each c In w.UsedRange
            If CStr(c) = v Then UserForm1.ListBox1.AddItem w.Name & "!" & c.Address(0, 0)
        Next c
    End If
Next w
Application.ScreenUpdating = True
If v <> "330" Then UserForm1.Show 0 'non modal
End Sub

Private Sub ListBox1_Click()
Application.Goto Range(ListBox1)
End Sub

A+

 

[Usine à gaz]

Bjr Gérard
Je te remercie pour cette nouvelle version .. Super !
Je vais occuper ma soirée lol
Je reviendrai te dire ce soir s'il n'est pas trop tard.
Je te fais un petit msg en msg privé...

 

[Usine à gaz]

Re-Gérard,

Je n'ai pas pu résister à l'envie de regarder ta nouvelle version
Super la boite proposant d'aller voir toutes les feuilles ou est le N° et d'y aller au clic.
Waooouuuu ! C'est génial ça !
Je verrai plus en détails ce soir...