Conflit entre 2 macros, besoin d'aide
Résolu
Anais0998
Messages postés
9
Statut
Membre
-
Anais0998 Messages postés 9 Statut Membre -
Anais0998 Messages postés 9 Statut Membre -
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>
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>
A voir également:
- Conflit entre 2 macros, besoin d'aide
- Supercopier 2 - Télécharger - Gestion de fichiers
- 2 ecran pc - Guide
- Faire 2 colonnes sur word - Guide
- Whatsapp 2 - Guide
- Transfert de fichier entre 2 pc par wifi - Guide
2 réponses
Bonjour
1) A quoi servent ces beaucoup trop nombreuses variables publiques ????
2) Au lieu de
il est préférable d'écrire :
et idem pour les suivants
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
Bonjour,
Essaies :
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
1) toutes ces variables sont les feuilles de mon classeur qui vont être concernées par la macro.
2) c'est ce que j'avais fait au départ, mais j'avais changé pensant alléger ma macro
2) il est préférable d'éviter d'employer le presse-papier.
Merci pour votre aide et bonne journée.
Donc pour copier les valeurs :
RangeDestination.Value = RangeSource.Value
et pour tout copier :
RangeSource.Copy Destination:=CellDestination
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