Problème pour combiner deux worksheet_selectionchange

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion dadahorse91
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
D

dadahorse91

Guest
Bonjour je n'arrive pas a combiner ces deux codes vba

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Or Target.Column > 11 Or Target.Row < 2 Then Exit Sub
If Fait = False Then
If Target = "" Then
Target = "X"
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
Range("B" & Target.Row & ":I" & Target.Row).Copy .Range("A" & Derli)
End With
Rem changement de cellule pour pouvoir corriger
Fait = True
Target.Offset(, 1).Select
Fait = False
Else
Target = ""
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
For Each cell In .Range("K2:K" & Derli)
If Target.Offset(, 1) = cell Then cell.EntireRow.Delete
Next
End With
Fait = True
Target.Offset(, 1).Select
Fait = False
End If
End If
End Sub

***************************************************************

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Or Target.Column > 13 Or Target.Row < 2 Then Exit Sub
If Fait = False Then
If Target = "" Then
Target = "X"
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
Range("B" & Target.Row & ":I" & Target.Row).Copy .Range("J" & Derli)
End With
Rem changement de cellule pour pouvoir corriger
Fait = True
Target.Offset(, 1).Select
Fait = False
Else
Target = ""
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
For Each cell In .Range("M2:M" & Derli)
If Target.Offset(, 1) = cell Then cell.EntireRow.Delete
Next
End With
Fait = True
Target.Offset(, 1).Select
Fait = False
End If
End If
End Sub

Merci d'avance de votre aide.
 
Trier par date Trier par votes
Re : Problème pour combiner deux worksheet_selectionchange

Bonsoir dadahorse91, bienvenue sur XLD,

Vous pouvez combiner autant de codes que vous voulez à condition de ne pas les bloquer par des tests avec Exit Sub.

Voici ce que ça donne, sans avoir testé la teneur de vos codes bien sûr :

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count = 1 And Target.Column < 12 And Target.Row > 1 Then
If Fait = False Then
If Target = "" Then
Target = "X"
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
Range("B" & Target.Row & ":I" & Target.Row).Copy .Range("A" & Derli)
End With
Rem changement de cellule pour pouvoir corriger
Fait = True
Target.Offset(, 1).Select
Fait = False
Else
Target = ""
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
For Each cell In .Range("K2:K" & Derli)
If Target.Offset(, 1) = cell Then cell.EntireRow.Delete
Next
End With
Fait = True
Target.Offset(, 1).Select
Fait = False
End If
End If
End If

If Target.Count = 1 And Target.Column < 14 And Target.Row > 1 Then
If Fait = False Then
If Target = "" Then
Target = "X"
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
Range("B" & Target.Row & ":I" & Target.Row).Copy .Range("J" & Derli)
End With
Rem changement de cellule pour pouvoir corriger
Fait = True
Target.Offset(, 1).Select
Fait = False
Else
Target = ""
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
For Each cell In .Range("M2:M" & Derli)
If Target.Offset(, 1) = cell Then cell.EntireRow.Delete
Next
End With
Fait = True
Target.Offset(, 1).Select
Fait = False
End If
End If
End If

End Sub
A+
 
Vote positif 0 Vote négatif
Re : Problème pour combiner deux worksheet_selectionchange

job75 à dit:
Bonsoir dadahorse91, bienvenue sur XLD,

Vous pouvez combiner autant de codes que vous voulez à condition de ne pas les bloquer par des tests avec Exit Sub.

Voici ce que ça donne, sans avoir testé la teneur de vos codes bien sûr :

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Count = 1 And Target.Column < 12 And Target.Row > 1 Then
If Fait = False Then
If Target = "" Then
Target = "X"
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
Range("B" & Target.Row & ":I" & Target.Row).Copy .Range("A" & Derli)
End With
Rem changement de cellule pour pouvoir corriger
Fait = True
Target.Offset(, 1).Select
Fait = False
Else
Target = ""
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
For Each cell In .Range("K2:K" & Derli)
If Target.Offset(, 1) = cell Then cell.EntireRow.Delete
Next
End With
Fait = True
Target.Offset(, 1).Select
Fait = False
End If
End If
End If

If Target.Count = 1 And Target.Column < 14 And Target.Row > 1 Then
If Fait = False Then
If Target = "" Then
Target = "X"
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
Range("B" & Target.Row & ":I" & Target.Row).Copy .Range("J" & Derli)
End With
Rem changement de cellule pour pouvoir corriger
Fait = True
Target.Offset(, 1).Select
Fait = False
Else
Target = ""
With Sheets("Impression")
Derli = .Range("A65536").End(xlUp).Row + 1
For Each cell In .Range("M2:M" & Derli)
If Target.Offset(, 1) = cell Then cell.EntireRow.Delete
Next
End With
Fait = True
Target.Offset(, 1).Select
Fait = False
End If
End If
End If

End Sub
A+
Cliquez pour agrandir...

Merci de votre aide mais par contre comment je fais pour exécuter la formule dans la colonne J parce que l'exemple ci-dessous est pour la colonne A

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Or Target.Column > 1 Or Target.Row < 2 Then Exit Sub
If Fait = False Then
If Target = "" Then
Target = "fait"
With Sheets("AA")
Derli = .Range("A65536").End(xlUp).Row + 1
Range("B" & Target.Row & ":T" & Target.Row).Copy .Range("A" & Derli)
End With
Rem changement de cellule pour pouvoir corriger
Fait = True
Target.Offset(, 1).Select
Fait = False
Else
Target = ""
With Sheets("AA")
Derli = .Range("A65536").End(xlUp).Row + 1
For Each cell In .Range("A2:A" & Derli)
If Target.Offset(, 1) = cell Then cell.EntireRow.Delete
Next
End With
Fait = True
Target.Offset(, 1).Select
Fait = False
End If
End If
 
Vote positif 0 Vote négatif
Re : Problème pour combiner deux worksheet_selectionchange

Re,

Vous avez demandé de combiner les codes, je vous ai dit comment faire.

Maintenant pour la mise au point de vos codes c'est une autre histoire et c'est hors sujet.

Revoyez tout ça en prenant votre temps et si vous bloquez sur un point particulier ouvrez une autre discussion.

En joignant un fichier pour bien exposer le problème.

A+
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

anthoYS
  • Résolu(e)
XL 2019 Modifier ce code pour de sorte à y rajouter un commentaire après clic droit en colonne I (9) à préremplir mais vierge ?
Réponses
8
Affichages
277
anthoYS
anthoYS
anthoYS
  • Résolu(e)
XL 2019 Comment modifier ces codes VB de sorte que le clic droit sur un commentaire présent, permette l'édition et non cette erreur (capture) ?
Réponses
6
Affichages
254
anthoYS
anthoYS
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
745
un internaute
U
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
617
un internaute
U
anthoYS
  • Résolu(e)
XL 2019 Adapter ce code, et améliorer le tableau avec graphique à l'année à y insérer ?
Réponses
4
Affichages
488
sylvanu
sylvanu
U
  • Question Question
Autres [RÉSOLU] Compléter macro pour Suppr cellules
Réponses
7
Affichages
457
un internaute
U
anthoYS
  • Résolu(e)
XL 2019 Clic droit en F doit afficher la fenêtre de commentaire, prêt à saisir vierge. Qu'est-ce qui cloche ici ? ça copie...
Réponses
1
Affichages
151
anthoYS
anthoYS
anthoYS
  • Résolu(e)
XL 2019 Insérer un commentaire prêt à saisir de B à X sans limite... (excepté en ligne 1 ; taille de commentaire Ok déjà voir code VB en B*)
Réponses
7
Affichages
264
Nicolas JACQUIN
Nicolas JACQUIN
treza88
  • Résolu(e)
XL 2021 Problème réaffectation variable Objet
Réponses
2
Affichages
240
treza88
treza88
deudecos
  • Résolu(e)
XL pour MAC Code vba pour recherche sur une seule ligne
Réponses
4
Affichages
183
deudecos
deudecos
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
482
nabilexcel2007
N
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
430
patricktoulon
patricktoulon
KTM
  • Question Question
XL 2016 Renseigner une plage 2 a partir d'une plage 1 selon le mois.
Réponses
4
Affichages
273
KTM
KTM
L
  • Résolu(e)
Microsoft 365 Erreur d'exécution 1004 : la méthode select de la classe Worksheet a échoué
Réponses
7
Affichages
269
LaurentVasseur
L
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
1 K
CortoXls
C
S
  • Question Question
Microsoft 365 VBA Action suivant le résultat d'une cellule
Réponses
7
Affichages
316
TooFatBoy
TooFatBoy
treza88
  • Question Question
XL 2021 La méthode union de l'objet '_Global' a échoué
Réponses
10
Affichages
342
sousou
sousou
anthoYS
  • Résolu(e)
XL 2019 colorer les différents aliments avec un code VB pour macro de ce genre ?
2
Réponses
16
Affichages
623
anthoYS
anthoYS
J
  • Résolu(e)
Microsoft 365 Valeur cellule dans un macro
2
Réponses
17
Affichages
689
job75
job75
lynyrd
  • Question Question
XL 2019 Prénoms à souhaiter
2
Réponses
15
Affichages
791
lynyrd
lynyrd
Retour