XL 2016 [VBA] problème macro EXCEL ne réponds pas

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.

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:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Terry,
Sans un fichier test représentatif, difficile de dire quoi que ce soit.
Après avoir créer 6 feuilles pour essayer de simuler j'ai finit par jeter l'éponge.
De plus si ça a marché et que ça ne marche plus, c'est que quelque chose à changer. Mais pas obligatoirement au niveau VBA, cela peut être dans une feuille. ( ajout suppression de données, modification de nom, ... )
Quelques questions à se poser :
1- Ai je des archives ? Si oui retestez une ancienne version.
2- Ai je fait des modifs dans le VBA ou dans une feuille ?
3- Ai je rajouté des feuilles ?
4- Le gestionnaire de noms à t il été modifié ?
5- Quelle erreur donne le VBA et sur quelle ligne ? Ou est ce simplement pas d'action du VBA ?
6- Le VBA aurait il été invalidé ?
7- Le VBA renvoie t-il au moins un msgbox ?
.....
 

patricktoulon

XLDnaute Barbatruc
bonjour

c'est pas etonnant tu bascule entre deux feuille a coup de activate et de find
tu m’étonne que le procc graphique a mal

il y a des solutions plus propres sans activer une feuille
les fonction find et autre fonctionnent très bien sans que la feuille concernée soit active
 

Phil69970

XLDnaute Barbatruc

terry08200

XLDnaute Nouveau
Bonjour @terry08200 ,Sylvain, Patrick

@terry08200 :

Manifestement au vu du code que tu as fourni tu n'as tenu aucun compte de mes remarques que je t'avais faite ici et ici mais comme tu ne m'as jamais répondu 😭 et il y a plus de 1 mois et demi !

Et surtout tu as indiqué ==> Re à tous j'ai réglé mon problème et cela fonctionne !!! , apparemment pas trop mais est ce surprenant ?

A quoi cela sert de t'aider si tu ne prends pas en compte ce que l'on te dit.

@Phil69970
bonjour,
Je vais replonger dedans et revenir vers vous, encore merci.
Quand j'ai dis que c'était réglé c'est que VBA fait ce que je lui demande. (résultat attendu).
"A quoi cela sert de t'aider si tu ne prends pas en compte ce que l'on te dit." Je vais faire plus d'effort pour être plus rigoureux.

Je ne sais pas comment décharger les set :(

Terry.
 
Dernière édition:

terry08200

XLDnaute Nouveau
Bonjour Terry,
Sans un fichier test représentatif, difficile de dire quoi que ce soit.
Après avoir créer 6 feuilles pour essayer de simuler j'ai finit par jeter l'éponge.
De plus si ça a marché et que ça ne marche plus, c'est que quelque chose à changer. Mais pas obligatoirement au niveau VBA, cela peut être dans une feuille. ( ajout suppression de données, modification de nom, ... )
Quelques questions à se poser :
1- Ai je des archives ? Si oui retestez une ancienne version.
2- Ai je fait des modifs dans le VBA ou dans une feuille ?
3- Ai je rajouté des feuilles ?
4- Le gestionnaire de noms à t il été modifié ?
5- Quelle erreur donne le VBA et sur quelle ligne ? Ou est ce simplement pas d'action du VBA ?
6- Le VBA aurait il été invalidé ?
7- Le VBA renvoie t-il au moins un msgbox ?
.....
Merci je vais faire le tour de la question et voir depuis, qu'est ce qui a changés ...
 

terry08200

XLDnaute Nouveau
Bonjour à tous

J'essaie de remplacer :
VB:
                                        'Worksheets("Outillage Commun").Activate
                                        '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.
Par
Code:
Worksheets("Outillage Commun").Range(AdressePlanCommun.Offset(0, -3), AdressePlanCommun.Offset(0, 11))=Worksheets("Nomenclature").Range(Numero_plan_recherche, Numero_plan_recherche.Offset(0, 14))

Dans l'optique de supprimer les activates .. select ... et d'avoir un code propre. Mais cela semble ne pas fonctionner.
j'ai essaye un code bidon ... mais ça ne fonctionne pas non plus.
Pourtant ça fonctionne avec une seule cellule
Code:
Sub toto1()
Worksheets("Outillage Commun").Range("A5", "B5") = Worksheets("Outillage Commun").Range("A6", "B6")
End Sub

Sub toto2()
Range("K27") = Range("K26") '<<---- fonctionne !!
End Sub

Avez-vous une solution svp ?

Bonne journée !!
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Therry, le forum,
Essayez :
VB:
Sub essai()
With Worksheets("Outillage Commun")
    .Range("A5:B5") = .Range("A6:B6").Value ' Copier Coller valeurs
End With
End Sub
Le With évite la répétition des feuilles. Ne pas oublier le point devant le Range qui indique la feuille à utiliser.
 

terry08200

XLDnaute Nouveau
Bonsoir Therry, le forum,
Essayez :
VB:
Sub essai()
With Worksheets("Outillage Commun")
    .Range("A5:B5") = .Range("A6:B6").Value ' Copier Coller valeurs
End With
End Sub
Le With évite la répétition des feuilles. Ne pas oublier le point devant le Range qui indique la feuille à utiliser.
Bonjour,

J'ai bien essayé de reproduire ton code, mais je n'y arrive pourtant pas :(
VB:
Sub ESSAI()
With Worksheets("Feuil1")
    .Range(Range("A1"), Range("O1")) = Worksheets("Feuil2").Range("A1:O1").Value ' Copier Coller valeurs
End With
End Sub
Sub TOTO3()
Worksheets("Feuil1").Range(Range("A1"), Range("O1")).Value = Worksheets("Feuil2").Range("A1:O1").Value
End Sub

Modification du 21/10/2021 à 14:14
ça fonctionne comme ça ...
VB:
Sub TOTO3()
Worksheets("Feuil1").Range(Range("A1"), Range("O1")).Value = ""
Worksheets("Feuil1").Range(Range("A1"), Range("O1")).Value = Worksheets("Feuil2").Range("A1:O1").Value
End Sub
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Terry,
J'ai bien essayé de reproduire ton code, mais je n'y arrive pourtant pas
Seulement mon code n'a jamais été :
VB:
.Range(Range("A1"), Range("O1")) = Worksheets("Feuil2").Range("A1:O1").Value ' Copier Coller valeurs
mais
Code:
.Range("A1:O1") = Worksheets("Feuil2").Range("A1:O1").Value ' Copier Coller valeurs
et il fonctionne, voir PJ.
 

Pièces jointes

  • Classeur1.xlsm
    15.7 KB · Affichages: 1

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 837
dernier inscrit
Ugo