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

T

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:
Trier par date Trier par votes
sylvanu

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 ?
.....
 
Vote positif 0 Vote négatif
patricktoulon

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
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
Vote positif 0 Vote négatif
T

terry08200

XLDnaute Nouveau
Phil69970 à dit:
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
Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif
T

terry08200

XLDnaute Nouveau
sylvanu à dit:
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 ?
.....
Cliquez pour agrandir...
Merci je vais faire le tour de la question et voir depuis, qu'est ce qui a changés ...
 
Vote positif 0 Vote négatif
T

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 !!
 
Vote positif 0 Vote négatif
sylvanu

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.
 
Vote positif 0 Vote négatif
T

terry08200

XLDnaute Nouveau
sylvanu à dit:
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.
Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Terry,
terry08200 à dit:
J'ai bien essayé de reproduire ton code, mais je n'y arrive pourtant pas
Cliquez pour agrandir...
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
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
236
sylvanu
sylvanu
U
  • Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
300
Phil69970
Phil69970
L
  • Question
XL 2021 Comment utiliser la colonne d'une adresse en Private Sub - svp ?
Réponses
3
Affichages
418
vgendron
vgendron
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
366
Francky79
F
C
  • Résolu(e)
XL 2019 Importer fichier csv sans consatener les colonnes
2 3
Réponses
34
Affichages
2 K
laurent950
laurent950
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
525
M@xu3L
M
D
  • Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
615
crocrocro
C
M
  • Résolu(e)
XL 2016 Private Sub ne fonctionne pas
Réponses
4
Affichages
383
MaNU84510
M
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
927
Nicolas JACQUIN
Nicolas JACQUIN
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
321
rebatte
R

Membres actuellement en ligne

17 membres et 289 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 709
Messages
2 112 103
Membres
111 418
dernier inscrit
mlds