bonjour,
comme a l'acoutumer je viens soliciter votre aide.
J'ai défini un userform de recherche par combobox !! le souci est que la macro commence a peser.
Je souhaiterai creer un fichier recherche avec un USF de recherche qui irai chercher les valeurs voulu dans un autre fichier xlms. est-ce possible pour alleger ma macro, ou sinon une correction de ce code est il possible ( car des que je le lance la macro plante le excel complet ) :
je pense que je ne devrai pas repeter la ligne :
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
si quelqu'un peut m'aider soit sur ce code VBa soit pour importer des données depuis un autre fichier je suis preneur !
cordialement
comme a l'acoutumer je viens soliciter votre aide.
J'ai défini un userform de recherche par combobox !! le souci est que la macro commence a peser.
Je souhaiterai creer un fichier recherche avec un USF de recherche qui irai chercher les valeurs voulu dans un autre fichier xlms. est-ce possible pour alleger ma macro, ou sinon une correction de ce code est il possible ( car des que je le lance la macro plante le excel complet ) :
Code:
Private Sub quit_Click()
Label_Alerte = ""
Unload Me
End Sub
Private Sub Userform_Initialize()
Dim Cell As Range
With Sheets("outillage")
For Each Cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
Me.CBoutillage.AddItem (Cell)
Next
End With
With Sheets("adhesif")
For Each Cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
Me.CBadhesif.AddItem (Cell)
Next
End With
With Sheets("primaire")
For Each Cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
Me.CBprimaire.AddItem (Cell)
Next
End With
With Sheets("sécurité")
For Each Cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
Me.CBsecurite.AddItem (Cell)
Next
End With
With Sheets("consommable outillage")
For Each Cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
Me.CBconso_outillage.AddItem (Cell)
Next
End With
With Sheets("consommable composite")
For Each Cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
Me.CBconso_composite.AddItem (Cell)
Next
End With
With Sheets("tissus sec")
For Each Cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
Me.CBtissus.AddItem (Cell)
Next
End With
With Sheets("prépreg")
For Each Cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
Me.CBprepreg.AddItem (Cell)
Next
End With
With Sheets("résine")
For Each Cell In .Range("B2:B" & .Range("B65536").End(xlUp).Row)
Me.CBresine.AddItem (Cell)
Next
End With
End Sub
Private Sub save_Click()
Dim X, occurence As Integer
Dim R As Range
Dim ligne As Long
Dim trouve As Boolean
Dim trouvé As Boolean 'déclare la variable trouvé
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
trouve = False
occurence = 0
ligne = 2
Label_Alerte = ""
'=======================================================
'Recherche parmi les noms de produits securite
'=======================================================
Set R = ThisWorkbook.Sheets("sécurité").Range("B:B").Find(What:=CBsecurite.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
trouve = True
For Each R In ThisWorkbook.Sheets("sécurité").Range("B1:B" & ThisWorkbook.Sheets("sécurité").Range("B:B").End(xlDown).Row)
If R.Text = CBsecurite.Value Then
With ThisWorkbook
If occurence = 0 Then
.Sheets("recherche").Range("B" & ligne).Value = .Sheets("sécurité").Range("B" & R.Row).Value
.Sheets("recherche").Range("C" & ligne).Value = .Sheets("sécurité").Range("A" & R.Row).Value
.Sheets("recherche").Range("D" & ligne).Value = .Sheets("sécurité").Range("C" & R.Row).Value
.Sheets("recherche").Range("E" & ligne).Value = "###########"
.Sheets("recherche").Range("F" & ligne).Value = .Sheets("sécurité").Range("E" & R.Row).Value
.Sheets("recherche").Range("G" & ligne).Value = "###########"
.Sheets("recherche").Range("H" & ligne).Value = "###########"
.Sheets("recherche").Range("I" & ligne).Value = "###########"
.Sheets("recherche").Range("J" & ligne).Value = .Sheets("sécurité").Range("H" & R.Row).Value
End If
End With
End If
Next R
occurence = 0
End If
'=======================================================
'Recherche parmi les noms de produits outillage
'=======================================================
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
trouve = False
occurence = 0
ligne = 2
Label_Alerte = ""
Set R = ThisWorkbook.Sheets("outillage").Range("B:B").Find(What:=CBoutillage.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
trouve = True
For Each R In ThisWorkbook.Sheets("outillage").Range("B1:B" & ThisWorkbook.Sheets("outillage").Range("B:B").End(xlDown).Row)
If R.Text = CBoutillage.Value Then
With ThisWorkbook
If occurence = 0 Then
.Sheets("recherche").Range("B" & ligne).Value = .Sheets("sécurité").Range("B" & R.Row).Value
.Sheets("recherche").Range("C" & ligne).Value = .Sheets("sécurité").Range("A" & R.Row).Value
.Sheets("recherche").Range("D" & ligne).Value = .Sheets("sécurité").Range("C" & R.Row).Value
.Sheets("recherche").Range("F" & ligne).Value = .Sheets("sécurité").Range("D" & R.Row).Value
.Sheets("recherche").Range("J" & ligne).Value = .Sheets("sécurité").Range("G" & R.Row).Value
End If
End With
End If
Next R
occurence = 0
End If
'=======================================================
'Recherche parmi les noms de produits dans PréPreg
'=======================================================
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
trouve = False
occurence = 0
ligne = 2
Label_Alerte = ""
Set R = ThisWorkbook.Sheets("prépreg").Range("B:B").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
trouve = True
For Each R In ThisWorkbook.Sheets("prépreg").Range("B1:B" & ThisWorkbook.Sheets("prépreg").Range("B:B").End(xlDown).Row)
If R.Text = CBprepreg.Value Then
With ThisWorkbook
If occurence = 0 Then
.Sheets("recherche").Range("B" & ligne).Value = .Sheets("prépreg").Range("B" & R.Row).Value
.Sheets("recherche").Range("C" & ligne).Value = .Sheets("prépreg").Range("A" & R.Row).Value
.Sheets("recherche").Range("D" & ligne).Value = .Sheets("prépreg").Range("I" & R.Row).Value
.Sheets("recherche").Range("E" & ligne).Value = .Sheets("prépreg").Range("J" & R.Row).Value
.Sheets("recherche").Range("F" & ligne).Value = .Sheets("prépreg").Range("O" & R.Row).Value
.Sheets("recherche").Range("G" & ligne).Value = .Sheets("prépreg").Range("M" & R.Row).Value
.Sheets("recherche").Range("H" & ligne).Value = .Sheets("prépreg").Range("D" & R.Row).Value
.Sheets("recherche").Range("I" & ligne).Value = .Sheets("prépreg").Range("C" & R.Row).Value
.Sheets("recherche").Range("J" & ligne).Value = .Sheets("prépreg").Range("S" & R.Row).Value
End If
.Sheets("recherche").Range("K" & ligne).Value = .Sheets("prépreg").Range("V" & R.Row).Value
.Sheets("recherche").Range("L" & ligne).Value = .Sheets("prépreg").Range("W" & R.Row).Value
occurence = occurence + 1
ligne = ligne + 1
End With
End If
Next R
occurence = 0
End If
'=======================================================
'Recherche parmi les noms des Tissu Sec
'=======================================================
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
Set R = ThisWorkbook.Sheets("tissus sec").Range("B:B").Find(What:=TBNumLot.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
trouve = True
For Each R In ThisWorkbook.Sheets("tissus sec").Range("B1:B" & ThisWorkbook.Sheets("tissus sec").Range("B:B").End(xlDown).Row)
If R.Text = CBsecurite.Value Then
With ThisWorkbook
If occurence = 0 Then
.Sheets("recherche").Range("B" & ligne).Value = .Sheets("tissus sec").Range("B" & R.Row).Value
.Sheets("recherche").Range("C" & ligne).Value = .Sheets("tissus sec").Range("A" & R.Row).Value
.Sheets("recherche").Range("D" & ligne).Value = .Sheets("tissus sec").Range("G" & R.Row).Value
.Sheets("recherche").Range("G" & ligne).Value = " #Pas de date# "
.Sheets("recherche").Range("H" & ligne).Value = .Sheets("tissus sec").Range("D" & R.Row).Value
.Sheets("recherche").Range("E" & ligne).Value = .Sheets("tissus sec").Range("H" & R.Row).Value
.Sheets("recherche").Range("F" & ligne).Value = .Sheets("tissus sec").Range("I" & R.Row).Value
.Sheets("recherche").Range("I" & ligne).Value = .Sheets("tissus sec").Range("C" & R.Row).Value
.Sheets("recherche").Range("J" & ligne).Value = .Sheets("tissus sec").Range("N" & R.Row).Value
End If
.Sheets("recherche").Range("K" & ligne).Value = .Sheets("tissus sec").Range("V" & R.Row).Value
.Sheets("recherche").Range("L" & ligne).Value = .Sheets("tissus sec").Range("W" & R.Row).Value
occurence = occurence + 1
ligne = ligne + 1
End With
End If
Next R
occurence = 0
End If
'=====================================================================
'Recherche parmi les noms de Consommable Composite
'=====================================================================
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
Set R = ThisWorkbook.Sheets("consommable composite").Range("B:B").Find(What:=CBconso_composite.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
trouve = True
For Each R In ThisWorkbook.Sheets("consommable composite").Range("B1:B" & ThisWorkbook.Sheets("consommable composite").Range("B:B").End(xlDown).Row)
If R.Text = CBconso_composite.Value Then
With ThisWorkbook
If occurence = 0 Then
.Sheets("recherche").Range("B" & ligne).Value = .Sheets("consommable composite").Range("B" & R.Row).Value
.Sheets("recherche").Range("C" & ligne).Value = .Sheets("consommable composite").Range("A" & R.Row).Value
.Sheets("recherche").Range("D" & ligne).Value = .Sheets("consommable composite").Range("H" & R.Row).Value
.Sheets("recherche").Range("E" & ligne).Value = .Sheets("consommable composite").Range("I" & R.Row).Value
.Sheets("recherche").Range("F" & ligne).Value = .Sheets("consommable composite").Range("K" & R.Row).Value
.Sheets("recherche").Range("G" & ligne).Value = .Sheets("consommable composite").Range("F" & R.Row).Value
.Sheets("recherche").Range("H" & ligne).Value = .Sheets("consommable composite").Range("D" & R.Row).Value
.Sheets("recherche").Range("I" & ligne).Value = .Sheets("consommable composite").Range("C" & R.Row).Value
.Sheets("recherche").Range("J" & ligne).Value = .Sheets("consommable composite").Range("N" & R.Row).Value
End If
.Sheets("recherche").Range("K" & ligne).Value = .Sheets("consommable composite").Range("V" & R.Row).Value
.Sheets("recherche").Range("L" & ligne).Value = .Sheets("consommable composite").Range("W" & R.Row).Value
occurence = occurence + 1
ligne = ligne + 1
End With
End If
Next R
occurence = 0
End If
'=====================================================================
'Recherche parmi les noms de Consommable outillage
'=====================================================================
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
Set R = ThisWorkbook.Sheets("consommable outillage").Range("B:B").Find(What:=CBconso_outillage.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
trouve = True
For Each R In ThisWorkbook.Sheets("consommable outillage").Range("B1:B" & ThisWorkbook.Sheets("consommable outillage").Range("B:B").End(xlDown).Row)
If R.Text = CBconso_outillage.Value Then
With ThisWorkbook
If occurence = 0 Then
.Sheets("recherche").Range("B" & ligne).Value = .Sheets("consommable composite").Range("B" & R.Row).Value
.Sheets("recherche").Range("C" & ligne).Value = .Sheets("consommable composite").Range("A" & R.Row).Value
.Sheets("recherche").Range("D" & ligne).Value = .Sheets("consommable composite").Range("H" & R.Row).Value
.Sheets("recherche").Range("E" & ligne).Value = .Sheets("consommable composite").Range("I" & R.Row).Value
.Sheets("recherche").Range("F" & ligne).Value = .Sheets("consommable composite").Range("K" & R.Row).Value
.Sheets("recherche").Range("G" & ligne).Value = .Sheets("consommable composite").Range("F" & R.Row).Value
.Sheets("recherche").Range("H" & ligne).Value = .Sheets("consommable composite").Range("D" & R.Row).Value
.Sheets("recherche").Range("I" & ligne).Value = .Sheets("consommable composite").Range("C" & R.Row).Value
.Sheets("recherche").Range("J" & ligne).Value = .Sheets("consommable composite").Range("N" & R.Row).Value
End If
.Sheets("recherche").Range("K" & ligne).Value = .Sheets("consommable composite").Range("V" & R.Row).Value
.Sheets("recherche").Range("L" & ligne).Value = .Sheets("consommable composite").Range("W" & R.Row).Value
occurence = occurence + 1
ligne = ligne + 1
End With
End If
Next R
occurence = 0
End If
'=======================================================
'Recherche parmi les noms de Résine
'=======================================================
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
Set R = ThisWorkbook.Sheets("résine").Range("B:B").Find(What:=CBresine.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
trouve = True
For Each R In ThisWorkbook.Sheets("résine").Range("B1:B" & ThisWorkbook.Sheets("résine").Range("B:B").End(xlDown).Row)
If R.Text = CBresine.Value Then
With ThisWorkbook
If occurence = 0 Then
.Sheets("recherche").Range("B" & ligne).Value = .Sheets("résine").Range("B" & R.Row).Value
.Sheets("recherche").Range("C" & ligne).Value = .Sheets("résine").Range("A" & R.Row).Value
.Sheets("recherche").Range("D" & ligne).Value = .Sheets("résine").Range("H" & R.Row).Value
.Sheets("recherche").Range("E" & ligne).Value = .Sheets("résine").Range("I" & R.Row).Value
.Sheets("recherche").Range("F" & ligne).Value = .Sheets("résine").Range("J" & R.Row).Value
.Sheets("recherche").Range("G" & ligne).Value = .Sheets("résine").Range("F" & R.Row).Value
.Sheets("recherche").Range("H" & ligne).Value = .Sheets("résine").Range("D" & R.Row).Value
.Sheets("recherche").Range("I" & ligne).Value = .Sheets("résine").Range("C" & R.Row).Value
.Sheets("recherche").Range("J" & ligne).Value = .Sheets("résine").Range("N" & R.Row).Value
End If
.Sheets("recherche").Range("K" & ligne).Value = .Sheets("résine").Range("V" & R.Row).Value
.Sheets("recherche").Range("L" & ligne).Value = .Sheets("résine").Range("W" & R.Row).Value
occurence = occurence + 1
ligne = ligne + 1
End With
End If
Next R
occurence = 0
End If
'=======================================================
'Recherche parmi les noms d'adhesif
'=======================================================
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
Set R = ThisWorkbook.Sheets("adhesif").Range("B:B").Find(What:=CBadhesif.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
trouve = True
For Each R In ThisWorkbook.Sheets("adhesif").Range("B1:B" & ThisWorkbook.Sheets("adhesif").Range("B:B").End(xlDown).Row)
If R.Text = CBadhesif.Value Then
With ThisWorkbook
If occurence = 0 Then
.Sheets("recherche").Range("B" & ligne).Value = .Sheets("résine").Range("B" & R.Row).Value
.Sheets("recherche").Range("C" & ligne).Value = .Sheets("résine").Range("A" & R.Row).Value
.Sheets("recherche").Range("D" & ligne).Value = .Sheets("résine").Range("H" & R.Row).Value
.Sheets("recherche").Range("E" & ligne).Value = .Sheets("résine").Range("I" & R.Row).Value
.Sheets("recherche").Range("F" & ligne).Value = .Sheets("résine").Range("J" & R.Row).Value
.Sheets("recherche").Range("G" & ligne).Value = .Sheets("résine").Range("F" & R.Row).Value
.Sheets("recherche").Range("H" & ligne).Value = .Sheets("résine").Range("D" & R.Row).Value
.Sheets("recherche").Range("I" & ligne).Value = .Sheets("résine").Range("C" & R.Row).Value
.Sheets("recherche").Range("J" & ligne).Value = .Sheets("résine").Range("N" & R.Row).Value
End If
.Sheets("recherche").Range("K" & ligne).Value = .Sheets("résine").Range("V" & R.Row).Value
.Sheets("recherche").Range("L" & ligne).Value = .Sheets("résine").Range("W" & R.Row).Value
occurence = occurence + 1
ligne = ligne + 1
End With
End If
Next R
occurence = 0
End If
'=======================================================
'Recherche parmi les noms de primaire
'=======================================================
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
Set R = ThisWorkbook.Sheets("primaire").Range("B:B").Find(What:=CBprimaire.Value, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not R Is Nothing Then 'condition si au moins une occurrence trouvée
trouve = True
For Each R In ThisWorkbook.Sheets("primaire").Range("B1:B" & ThisWorkbook.Sheets("primaire").Range("B:B").End(xlDown).Row)
If R.Text = CBprimaire.Value Then
With ThisWorkbook
If occurence = 0 Then
.Sheets("recherche").Range("B" & ligne).Value = .Sheets("résine").Range("B" & R.Row).Value
.Sheets("recherche").Range("C" & ligne).Value = .Sheets("résine").Range("A" & R.Row).Value
.Sheets("recherche").Range("D" & ligne).Value = .Sheets("résine").Range("H" & R.Row).Value
.Sheets("recherche").Range("E" & ligne).Value = .Sheets("résine").Range("I" & R.Row).Value
.Sheets("recherche").Range("F" & ligne).Value = .Sheets("résine").Range("J" & R.Row).Value
.Sheets("recherche").Range("G" & ligne).Value = .Sheets("résine").Range("F" & R.Row).Value
.Sheets("recherche").Range("H" & ligne).Value = .Sheets("résine").Range("D" & R.Row).Value
.Sheets("recherche").Range("I" & ligne).Value = .Sheets("résine").Range("C" & R.Row).Value
.Sheets("recherche").Range("J" & ligne).Value = .Sheets("résine").Range("N" & R.Row).Value
End If
.Sheets("recherche").Range("K" & ligne).Value = .Sheets("résine").Range("V" & R.Row).Value
.Sheets("recherche").Range("L" & ligne).Value = .Sheets("résine").Range("W" & R.Row).Value
occurence = occurence + 1
ligne = ligne + 1
End With
End If
Next R
occurence = 0
End If
If trouve = False Then
Label_Alerte = "Aucune information trouvée"
Else
ThisWorkbook.Sheets("recherche").Activate
Unload Me
End If
End Sub
je pense que je ne devrai pas repeter la ligne :
ThisWorkbook.Sheets("recherche").Range("B2:J" & ThisWorkbook.Sheets("recherche").Range("I:I").End(xlDown).Row).ClearContents
si quelqu'un peut m'aider soit sur ce code VBa soit pour importer des données depuis un autre fichier je suis preneur !
cordialement