Mydata inputbox [Résolu/Fermé]

Signaler
-
 PIERRE -
Bonjour,



Bonsoir,ce code ne marche pas, problème MyData = Application.InputBox("Entrez donnée à chercher, valeur alphanumérique") peut être,si vous pouvez m'aidez sur ce code merci. Je vous remercie pour votre aide hier ,mais les 2 codes que vous m'avez proposé ne marche pas .Je continue de chercher.

Sub Transfert_Prod()
'
' Transfert_Prod Macro
'

'
Workbooks.Open Filename:="C:\Users\jmorante\Desktop\Gestion Production L03\MMS686PF"


ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
Columns("X:X").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste

Columns("W:W").Select
Selection.TextToColumns Destination:=Range("W1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(9, 1), Array(16, 1), Array(21, 1)), _
TrailingMinusNumbers:=True
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
Columns("X:AP").Select
Selection.Delete Shift:=xlToLeft
Range("V16").Select
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1



Dim Lig1 As Long, Derlig1 As Long, Derlig2 As Long, Cp As Variant
Dim Lig2 As Long

Dim Plage As Range
Dim MyFile As Variant
MyData = Application.InputBox("Entrez donnée à chercher, valeur alphanumérique")
Dim NbLignes
NbLignes = ActiveSheet.UsedRange.Rows.Count
Set Plage = Worksheets("MMS686PF").Range("W1:W" & NbLignes)

Sheets.Add
ActiveSheet.Name = "Recherche_Réf"

Worksheets("MMS686PF").Range("A1:W1").Copy
Sheets("Recherche_Réf").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1:W1").font.Bold = True

For Each Cell In Plage
If MyData = Cell.Value Then

Cell.Interior.ColorIndex = 6
Cell.EntireRow.Copy
Worksheets("Recherche_Réf").Select
Cells(65999, 1).End(xlUp)(2).Select
ActiveSheet.Paste
Else
If MyData = Empty Then
MsgBox "Aucune Valeur rentrée, essayez à nouveau ou fin"
ActiveWorkbook.Close SaveChanges:=False
Exit Sub
End If
End If
Next Cell



Worksheets("Recherche_Réf").Select
Range("B79").Activate
ActiveSheet.Range("$A$1:$W$" & NbLignes).RemoveDuplicates Columns:=3, Header:=xlYes
ActiveWindow.SmallScroll Down:=-84
Range("F:L").Delete
Cells.Select
Cells.EntireColumn.AutoFit





Derlig1 = Sheets("Recherche_Réf").Range("D65535").End(xlUp).Row
Derlig2 = Sheets("MMS686PF").Range("D65535:W65535").End(xlUp).Row


With Sheets("MMS686PF")
For Lig1 = 2 To Derlig1
Cp = Sheets("Recherche_Réf").Cells(Lig1, "D")
For Lig2 = 2 To Derlig2
If Cp = .Cells(Lig2, "D") And .Cells(Lig2, "W") = "L01=>L03" Then

Sheets("Recherche_Réf").Cells(Lig1, "Q").Value = "L01=>L03"
Sheets("Recherche_Réf").Cells(Lig1, "Q").Interior.ColorIndex = 19
Else

If Cp = .Cells(Lig2, "D") And .Cells(Lig2, "R") = "251" Then

Sheets("Recherche_Réf").Cells(Lig1, "Q").Value = "Cde en cours"
Sheets("Recherche_Réf").Cells(Lig1, "Q").Interior.ColorIndex = 44

End If

End If
Next Lig2
Next Lig1
End With


With Sheets("MMS686PF")
For Lig1 = 2 To Derlig1
Cp = Sheets("Recherche_Réf").Cells(Lig1, "D")
For Lig2 = 2 To Derlig2
If Cp = .Cells(Lig2, "D") And .Cells(Lig2, "R") = "101" Then

Sheets("Recherche_Réf").Cells(Lig1, "Q").Value = "Ordre de Fab."
Sheets("Recherche_Réf").Cells(Lig1, "Q").Interior.ColorIndex = 8

End If
Next Lig2
Next Lig1
End With



Sheets.Add
ActiveSheet.Name = "Commandes & OF_" & MyData
Worksheets("MMS686PF").Range("A1:W1").Copy
Sheets("Commandes & OF_" & MyData).Select
Range("A1").Select
ActiveSheet.Paste
Range("A1:W1").font.Bold = True


With Sheets("MMS686PF")
For Lig1 = 2 To Derlig1
Cp = Sheets("Recherche_Réf").Cells(Lig1, "D")
For Lig2 = 2 To Derlig2
If Cp = .Cells(Lig2, "D") And .Cells(Lig2, "R") = "251" Or Cp = .Cells(Lig2, "D") And .Cells(Lig2, "R") = "101" Then

.Cells(Lig2, "D").EntireRow.Copy
Worksheets("Commandes & OF_" & MyData).Select
Cells(65999, 1).End(xlUp)(2).Select
ActiveSheet.Paste

End If
Next Lig2
Next Lig1
End With



Range("F:L").Delete
Cells.Select
Cells.EntireColumn.AutoFit

NbLignes = ActiveSheet.UsedRange.Rows.Count
Set Plage = Worksheets("Commandes & OF_" & MyData).Range("K2:K" & NbLignes)

For Each Cell In Plage
If Cell.Value = 251 Then
Cell.Interior.ColorIndex = 44
Else
Cell.Interior.ColorIndex = 8
End If
Next Cell

Range("A1").Select

End Sub

3 réponses

Messages postés
15726
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
13 avril 2021
1 481
Bonjour,

Vous dites que ce qui est propose ici:
MYDATA.application
PIERRE - 10 mai 2017 à 19:56 - Dernière réponse le 11 mai 2017 à 08:00 par f894009

Ne marche pas, peut-etre(quoique...), mais si vous nous disiez ce qui ne marche pas genre erreur Excel ou autre(s)

Ne creez pas de nouvelle demande a chaque fois!
bonjour merci pour votre réponse,mon problème est que la valeur (ex :L12300) entrée par l'utilisateur dans l'Inputbox n'est pas prise en compte et on passe directement au else if mydata =Empty et on sort du code Exit sub si cela peut vous aidez merci par avance.je ne comprend pas pourquoi?
Messages postés
15726
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
13 avril 2021
1 481
Re,

Avec votre fichier, ce serait un peu plus simple pour vous repondre, fichier avec l'onglet MMS686PF evidemment

Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com

Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
je vous remercie pour votre aide,je pense avoir trouvé le problème en me servant de l'espion dans le débogage je me suis aperçu que la valeur dans l'inputbox était bien prise en compte mais cette valeur référence que l'on ma donné à chercher n'est pas dans la bonne colonne de la base de donnée,ce qui explique que je passais au Else c'est vraiment tout bête je vais pouvoir tester la semaine prochaine.MERCI ENCORE