Menu

Conflit entre 2 macros, besoin d'aide [Résolu]

Messages postés
9
Date d'inscription
lundi 4 mars 2019
Dernière intervention
14 mars 2019
- - Dernière réponse : Anais0998
Messages postés
9
Date d'inscription
lundi 4 mars 2019
Dernière intervention
14 mars 2019
- 8 mars 2019 à 12:45
Bonjour à tous,

Tout d'abord, je débute en programmation vba. Soit je me sers de l'enregistreur de macro, soit je teste et récupère des bouts de codes à droite à gauche, tout en consultant les nombreuses fiches de cours que l'on peut trouver sur le net, mais j'avoue que je m'embrouille très vite dans le domaine, à mon grand désespoir ...

Je bute depuis plusieurs jours sur un problème de conflit, à mon avis, entre 2 macro sur la même feuille, l'une avec worksheet_change ... et l'autre avec worksheet_selectionchange ...

La première fonctionne bien, la seconde, qui appelle 2 autres macros, a fonctionné lors du premier lancement, mais depuis, elle ne fonctionne plus (lorsque je sélectionne n'importe quelle cellule de ma feuille, ma sélection s'annule aussitôt pour toujours sélectionner ma cellule A1.

C'est la raison qui m'a poussée aujourd'hui à m'adresser à vous, en espérant trouver rapidement une solution car je vais avoir besoin de mon fichier mercredi.


Je ne peux pas transmettre mon fichier car il ne contient que des informations personnelles, alors si cela est possible, pourrez-vous jeter un oeil sur mes codes, au cas où ...

Dans tous les cas, je vous remercie d'avance pour tous les conseils que vous pourriez me donner, sachant que vous allez sûrement vous arracher les cheveux en découvrant mes codes ...

Je vous souhaite une belle journée.


PS : je n'arrive pas à poster tous mes codes d'un coup, je commence par celui là des fois que les erreurs y seraient cachées, encore merci d'avance



<
Dim An2010 As Worksheet, An2011 As Worksheet, An2012 As Worksheet, An2013 As Worksheet, An2014 As Worksheet, An2015 As Worksheet, _
An2016 As Worksheet, An2017 As Worksheet, An2018 As Worksheet, An2019 As Worksheet, An2020 As Worksheet, An2021 As Worksheet, An2022 As Worksheet, _
An2023 As Worksheet, An2024 As Worksheet, An2025 As Worksheet, An2026 As Worksheet, An2027 As Worksheet, An2028 As Worksheet, An2029 As Worksheet, _
An2030 As Worksheet, An2031 As Worksheet, An2032 As Worksheet, An2033 As Worksheet, An2034 As Worksheet, An2035 As Worksheet, An2036 As Worksheet, _
An2037 As Worksheet, An2038 As Worksheet, An2039 As Worksheet, An2040 As Worksheet

Dim selectionlot As Range, PlagedeRecherche As Range, ValeurTrouvee As String, AdresseTrouvee As Variant
Dim PlagedeRechercheP As Range, ValeurTrouveeP As String, AdresseTrouveeP As Variant
Dim ZoneAcopier As Range, ZoneAcoller As Range





Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim WsRech As Worksheet
Dim WsResult As Worksheet
Dim selection1 As Range
Dim selection2 As Range



Set selectionlot = Range("A1")
Set WsRech = ThisWorkbook.worksheets("Formulaire")
Set WsResult = ThisWorkbook.worksheets("ListesAVB2")

Set selection2 = Sheets("Formulaire").Range("L2:AJ32")
Set selection1 = Sheets("ListesAVB2").Range("V2:AT32")


If Not Application.Intersect(selectionlot, Range(Target.Address)) Is Nothing Then
Application.DisplayAlerts = False

WsResult.Range("J2").Copy
WsRech.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Statut COTISATIONS

WsResult.Range("K7").Copy
WsRech.Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Statut PROPRIETAIRE

WsResult.Range("K4").Copy 'date achat
WsRech.Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K5").Copy 'impayés
WsRech.Range("B5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K6").Copy 'proprietaire
WsRech.Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K8").Copy 'téléphone fixe
WsRech.Range("B8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K9").Copy 'mobilis
WsRech.Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K10").Copy 'courriel
WsRech.Range("B10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K12").Copy 'conjoint
WsRech.Range("B12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K13").Copy 'mobilis conj
WsRech.Range("B13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K14").Copy 'courriel conj
WsRech.Range("B14").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K16").Copy 'adresse
WsRech.Range("B16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K17").Copy 'code postal adresse
WsRech.Range("B17").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K18").Copy 'commune adresse
WsRech.Range("B18").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K19").Copy 'Bp
WsRech.Range("B19").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K20").Copy 'code postal BP
WsRech.Range("B20").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

WsResult.Range("K21").Copy 'commune BP
WsRech.Range("B21").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'WsRech.Range("B23") = WsResult.Range("K22").Value 'commune BP

selection1.Copy
selection2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False



End

Application.EnableEvents = True

End Sub></code>
Afficher la suite 

Votre réponse

2 réponses

Meilleure réponse
Messages postés
7678
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
16 mars 2019
1663
1
Merci
Bonjour

1) A quoi servent ces beaucoup trop nombreuses variables publiques ????
Dim An2010 As Worksheet, An2011 As Worksheet, An2012 As Worksheet, An2013 As Worksheet, An2014 As Worksheet, An2015 As Worksheet ...,

2) Au lieu de
WsResult.Range("J2").Copy
WsRech.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Statut COTISATIONS

il est préférable d'écrire :
WsRech.Range("B1").Value = WsResult.Range("J2").Value  'Statut COTISATIONS

et idem pour les suivants
Cordialement
Patrice

Dire « Merci » 1

Heureux de vous avoir aidé ! Vous nous appréciez ? Donnez votre avis sur nous ! Evaluez CommentCaMarche

CCM 49159 internautes nous ont dit merci ce mois-ci

Patrice33740
Messages postés
7678
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
16 mars 2019
1663 -
Pour éviter d'utiliser le presse papier, il faut éviter Copy suivi d'un Paste.
Donc pour copier les valeurs :
RangeDestination.Value = RangeSource.Value
et pour tout copier :
RangeSource.Copy Destination:=CellDestination
Anais0998
Messages postés
9
Date d'inscription
lundi 4 mars 2019
Dernière intervention
14 mars 2019
-
Bonjour et merci encore pour vos précieux conseils.

J'ai finalement changé mes procédures car avec un worksheet change et un worksheet selectionchange sur la même feuille, c'était vraiment le bazar complet. J'ai donc refait mes codes et inséré des boutons déclencheurs pour les macros. Par contre, il y a encore un truc qui m'échappe. J'ai 2 feuilles distinctes 1 et 2. La (2) contient des MEFC, et lorsque je fais des "copié/collé" de la feuille 1 vers le feuille 2, c'est la panique dans mes MEFC. Pourtant je ne fais que coller de valeurs à la place d'autres valeurs, donc pas de rajout dans mon tableau. J'aimerais que mes MEFC ne changent pas. Je vous mets mon code actuel, si vous aviez une idée des erreurs à corriger. Je vous en remercie d'avance. de plus, je ne vois pas comment adapter ce code avec vos explications sur le copié collé ...

<

Sub EnregModif_proprietaires()

Application.ScreenUpdating = False

Dim wksp As Worksheet, wksf As Worksheet
Dim selectionlot As Range
Set selectionlot = ThisWorkbook.worksheets("Formulaire").Range("A1")
Set wksp = ThisWorkbook.worksheets("Proprietaires")
Set wksf = ThisWorkbook.worksheets("Formulaire")


ValeurTrouveeP = selectionlot.Value

Set PlagedeRechercheP = Sheets("Proprietaires").Columns(1)

Set AdresseTrouveeP = PlagedeRechercheP.Cells.Find(what:=ValeurTrouveeP, LookAt:=xlWhole)

If Not AdresseTrouveeP Is Nothing Then

AdresseTrouveeP = AdresseTrouveeP.Address

Application.Goto Reference:=wksp.Range(AdresseTrouveeP), scroll:=True




ActiveCell.Offset(0, 1).Select 'date achat
wksf.Range("B4").Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select 'proprietaire
wksf.Range("B7").Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 2).Select
wksf.Range("B23").Copy 'observations
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False



ActiveCell.Offset(0, 1).Select
wksf.Range("B12").Copy 'conjoint
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select
wksf.Range("B16").Copy 'adresse
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select
wksf.Range("B17").Copy 'cp adresse
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select
wksf.Range("B18").Copy 'commune adresse
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select
wksf.Range("B19").Copy 'bp
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select
wksf.Range("B20").Copy 'cp bp
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select
wksf.Range("B21").Copy 'commune bp
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 2).Select
wksf.Range("B8").Copy 'telephone fixe
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select
wksf.Range("B9").Copy 'mobilis proprietaire
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select
wksf.Range("B13").Copy 'mobilis conjoint
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select
wksf.Range("B10").Copy 'mail proprietaire
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 1).Select
wksf.Range("B14").Copy 'mail conjoint
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False


ActiveCell.Offset(0, 5).Select
wksf.Range("B3").Copy 'conjoint
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False




Application.Goto Reference:=wksp.Range(AdresseTrouveeP), scroll:=True
ActiveCell.Select



Application.ScreenUpdating = True

End With
End If
End Sub
Patrice33740
Messages postés
7678
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
16 mars 2019
1663 -
Bonjour,
Si je te donne des conseils c'est pour que tu les appliques !
J'en ajouterais un, vu que tu as sérieusement dégradé la qualité du code initial :
- Ne pas utiliser ni .Select, ni ActiveCell
Anais0998
Messages postés
9
Date d'inscription
lundi 4 mars 2019
Dernière intervention
14 mars 2019
-
Bonjour Patrice33740 et merci, j'ai enfin réussi à accorder mes violons avec ce code

Sub EnregModif_proprietaires()

Application.ScreenUpdating = False

Dim wksp As Worksheet, wksf As Worksheet
Dim selectionlot As Range
Dim PlagedeRechercheP As Range, ValeurTrouveeP As String, AdresseTrouveeP As Variant

Set selectionlot = ThisWorkbook.worksheets("Formulaire").Range("A1")
Set wksp = ThisWorkbook.worksheets("Proprietaires")
Set wksf = ThisWorkbook.worksheets("Formulaire")


ValeurTrouveeP = selectionlot.Value

Set PlagedeRechercheP = Sheets("Proprietaires").Columns(1)

Set AdresseTrouveeP = PlagedeRechercheP.Cells.Find(what:=ValeurTrouveeP, LookAt:=xlWhole)

If Not AdresseTrouveeP Is Nothing Then

AdresseTrouveeP = AdresseTrouveeP.Address

Application.Goto Reference:=wksp.Range(AdresseTrouveeP), scroll:=True


With wksp.Range(AdresseTrouveeP)
.Offset(0, 1).Value = wksf.Range("B4").Value
.Offset(0, 2).Value = wksf.Range("B7").Value
.Offset(0, 4).Value = wksf.Range("B23").Value
.Offset(0, 5).Value = wksf.Range("B12").Value
.Offset(0, 6).Value = wksf.Range("B16").Value
.Offset(0, 7).Value = wksf.Range("B17").Value
.Offset(0, 8).Value = wksf.Range("B18").Value
.Offset(0, 9).Value = wksf.Range("B19").Value
.Offset(0, 10).Value = wksf.Range("B20").Value
.Offset(0, 11).Value = wksf.Range("B21").Value
.Offset(0, 13).Value = wksf.Range("B8").Value
.Offset(0, 14).Value = wksf.Range("B9").Value
.Offset(0, 15).Value = wksf.Range("B13").Value
.Offset(0, 16).Value = wksf.Range("B10").Value
.Offset(0, 17).Value = wksf.Range("B14").Value
.Offset(0, 22).Value = wksf.Range("B3").Value


Application.Goto Reference:=wksp.Range(AdresseTrouveeP), scroll:=True
ActiveCell.Select

Application.ScreenUpdating = True

End With
End If
End Sub
Anais0998
Messages postés
9
Date d'inscription
lundi 4 mars 2019
Dernière intervention
14 mars 2019
-
..... Par contre, je n'y arrive pas avec cet autre code, la macro fonctionne mais le copié collé ne fonctionne pas, j'ai pourtant appliqué tes conseils comme pour le code au dessus

Sub EnregistrerModifications2010()
Application.ScreenUpdating = False

Dim PlagedeRecherche As Range, ValeurTrouvee As String, AdresseTrouvee As Variant
Dim An2010 As Worksheet

Set PlagedeRecherche = Sheets("an2010").Columns(1)
Set selectionlot = ThisWorkbook.worksheets("Formulaire").Range("A1")

ValeurTrouvee = selectionlot.Value
Set AdresseTrouvee = PlagedeRecherche.Cells.Find(what:=ValeurTrouvee, LookAt:=xlWhole)

If Not AdresseTrouvee Is Nothing Then
AdresseTrouvee = AdresseTrouvee.Address

Set ZoneAcopier = Sheets("Formulaire").Range("L2:AJ2")
Set ZoneAcoller = Sheets("an2010").Range(AdresseTrouvee).Offset(0, 12)

Application.Goto Reference:=Sheets("an2010").Range(AdresseTrouvee), scroll:=True

With Sheets("an2010")
.Range(AdresseTrouvee).Offset(0, 12).Value = Sheets("Formulaire").Range("L2:AJ2").Value


If MsgBox("Les modifications ont bien été enregistrées. Souhaitez-vous consulter la base de données ?", vbYesNo, _
"Confirmation de l'enregistrement des modifications") = vbYes Then

Application.Goto Reference:=ActiveCell, scroll:=True

End If
End With
End If

End Sub





Merci d'avance pour ton aide.
Commenter la réponse de Patrice33740
Messages postés
7678
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
16 mars 2019
1663
1
Merci
Bonjour,

Essaies :
Option Explicit
Sub EnregistrerModifications2010()
Dim PlagedeRecherche As Range
Dim SelectionLot As Range
Dim ZoneAcopier As Range
Dim ZoneAcoller As Range
Dim AdresseTrouvee As Range
Dim ValeurTrouvee As Variant
  
  Application.ScreenUpdating = False
  With Worksheets("an2010")
    Set PlagedeRecherche = Intersect(.Columns(1), .UsedRange)
  End With
  Set SelectionLot = Worksheets("Formulaire").Range("A1")
  ValeurTrouvee = SelectionLot.Value
  Set AdresseTrouvee = PlagedeRecherche.Cells.Find(what:=ValeurTrouvee, LookAt:=xlWhole)
  If Not AdresseTrouvee Is Nothing Then
    Set ZoneAcopier = Worksheets("Formulaire").Range("L2:AJ2")
    Set ZoneAcoller = AdresseTrouvee.Offset(0, 12).Resize(1, ZoneAcopier.Columns.Count)
    ZoneAcoller.Value = ZoneAcopier.Value
    If MsgBox("Les modifications ont bien été enregistrées. Souhaitez-vous consulter la base de données ?", vbYesNo, _
              "Confirmation de l'enregistrement des modifications") = vbYes Then
      'Application.Goto Reference:=ActiveCell, scroll:=True 'ça c'est inutile !
    Else
      Application.Goto Reference:=AdresseTrouvee, scroll:=True
    End If
  End If

End Sub
 

Dire « Merci » 1

Heureux de vous avoir aidé ! Vous nous appréciez ? Donnez votre avis sur nous ! Evaluez CommentCaMarche

CCM 49159 internautes nous ont dit merci ce mois-ci

Anais0998
Messages postés
9
Date d'inscription
lundi 4 mars 2019
Dernière intervention
14 mars 2019
-
Bonjour Patrice et merci pour ce code qui fonctionne !!!

Je vais maintenant pouvoir continuer mon petit programme, en cas de besoin de reviendrai par ici.

Encore un grand merci pour ta générosité.

Belle journée.
Commenter la réponse de Patrice33740