terry08200
XLDnaute Nouveau
Bonjour la communauté,
j'ai un soucis avec la macro suivante.
Je ne sais pas mettre le doigts sur le problème.
Avant elle fonctionnait, mais ça c'était avant.
Voici le code, j'espère que vous pouvez m'aider.
Dans une feuille Excel, j'appelle les lignes de plusieurs autres feuilles d'après un critère.
Je peux les modifier sur la feuille en question. Mais après modification je dois les renvoyer à l'endroit ou elle était et les écraser.
J'ai déjà testé la macro les centaines de fois et il n'y avait pas de soucis. Pourquoi maintenant ?
Pouvez-vous me donner des pistes d'amélioration ?
Bien à vous, Terry.
j'ai un soucis avec la macro suivante.
Je ne sais pas mettre le doigts sur le problème.
Avant elle fonctionnait, mais ça c'était avant.
Voici le code, j'espère que vous pouvez m'aider.
Dans une feuille Excel, j'appelle les lignes de plusieurs autres feuilles d'après un critère.
Je peux les modifier sur la feuille en question. Mais après modification je dois les renvoyer à l'endroit ou elle était et les écraser.
J'ai déjà testé la macro les centaines de fois et il n'y avait pas de soucis. Pourquoi maintenant ?
Pouvez-vous me donner des pistes d'amélioration ?
Bien à vous, Terry.
VB:
Public Sub Valide_Modif()
Application.ScreenUpdating = False
Continue = MsgBox("Voulez-vous continuer ?" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Les infos du tableau vont être validées !", vbQuestion + vbYesNo + vbDefaultButton2, "Continuer ?") 'valider ou arreter
If Continue = vbNo Then
MsgBox "Procédure annulée", vbCritical
Exit Sub
End If
If Range("Q2") = "" Then 'éviter de mouliner dans le vide et faire crasher excel !!!!!!
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
ElseIf Range("Q2") = "X" Then
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
ElseIf Range("Q2") = "XX" Then
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
ElseIf Range("Q2") = "XXX" Then 'évite faire n'importe quoi et remonter les X, XX, XXX ... !!
MsgBox "Fin de l'éxécution ... rien à valider", vbExclamation
Exit Sub
End If
Dim AdressePlan As Range
Dim AdressePlanCommun As Range
Dim Numero_plan_recherche As Range
Worksheets("Nomenclature").Activate 'active la page des plans
celfin = Range("A1:A" & Range("A1").End(xlDown).Row).Count 'récupère le nombre de cellule non vide
For Cel = 1 To celfin - 1 'de la cellule A2 a A dernière remplie
Worksheets("Nomenclature").Activate 'active la page des plans
Range("A" & 1).Activate
Set Numero_plan_recherche = ActiveCell.Offset(Cel, 0)
Range(Numero_plan_recherche, Numero_plan_recherche.Offset(0, 14)).Copy 'copie la ligne
Worksheets("Classeur Plans").Activate
With Worksheets("Classeur Plans").Range("A1:A" & Range("A1").End(xlDown).Row) ' POUR CHAQUE RECHERCHE PAR PAGE, ON CHOISIS LA PLAGE COLONNE A
Set AdressePlan = .Find(Numero_plan_recherche, LookIn:=xlValues) 'pour éviter de coller dans la colonne DOSSIER quand des communs retrouve leurs parain !!
If AdressePlan Is Nothing Then
Worksheets("ARCHIVES").Activate
With Worksheets("ARCHIVES").Range("A1:A" & Range("A1").End(xlDown).Row)
Set AdressePlan = .Find(Numero_plan_recherche, LookIn:=xlValues)
If AdressePlan Is Nothing Then
Worksheets("ARCHIVES2").Activate
With Worksheets("ARCHIVES2").Range("A1:A" & Range("A1").End(xlDown).Row)
Set AdressePlan = .Find(Numero_plan_recherche, LookIn:=xlValues)
If AdressePlan Is Nothing Then
Worksheets("Outillage Commun").Activate 'active la page des archives
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
If Sh.FilterMode Then 'Si on ne voit pas toutes les données
Sh.ShowAllData
End If
Next
'**********COMME IL S'AGIT DE PLAN COMMUN ON CHERCHE PAR DESIGNATION
ActiveSheet.Range("$A$1:$J$9").AutoFilter Field:=1, Criteria1:=Numero_plan_recherche
With Worksheets("Outillage Commun").Range("D1:D" & Range("D1").End(xlDown).Row)
Set AdressePlanCommun = .Find(Numero_plan_recherche.Offset(0, 3), LookIn:=xlValues)
If AdressePlanCommun Is Nothing Then 'si adresse plan aps trouvé
Worksheets("Outillage Commun").ShowAllData 'désactive les filtres
Else
Worksheets("Outillage Commun").Activate 'c'était pas prore au dessus et j'avais des problèmes de type ...
AdressePlanCommun.Offset(0, -3).Select
Worksheets("Nomenclature").Activate
Range(Numero_plan_recherche, Numero_plan_recherche.Offset(0, 14)).Copy 'copie la ligne 'JE REFAIS LA COPIE DANS LE DOUTE ... DE COLLER DU VIDE A CAUSE DES SELECT
Worksheets("Outillage Commun").Activate
ActiveSheet.Paste 'colle la selection copier précédemment.
Worksheets("Outillage Commun").ShowAllData
End If
End With
ElseIf Not AdressePlan Is Nothing Then
AdressePlan.Select 'selectionne la case si trouvé
ActiveSheet.Paste 'colle la selection copier précédemment
End If
End With
ElseIf Not AdressePlan Is Nothing Then
AdressePlan.Select 'selectionne la case si trouvé
ActiveSheet.Paste 'colle la selection copier précédemment
End If
End With
ElseIf Not AdressePlan Is Nothing Then
AdressePlan.Select 'selectionne la case si trouvé
ActiveSheet.Paste 'colle la selection copier précédemment
End If
End With
Next Cel
Worksheets("Nomenclature").Activate
Application.ScreenUpdating = True
Dernière édition:
et il y a plus de 1 mois et demi !
