Demande d'aide sur: Private Sub Worksheet_Change

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion degap05
  • 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

degap05

XLDnaute Impliqué
Bonjour, je sollicite de l'aide car je n'y arrive pas.

Voilà une macro qui fonctionne, fournie par un membre du forum🙂🙂🙂:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig, derlig, num1 As Integer
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Column = 27 Then
lig = Target.Row
derlig = Sheets("Ordonnancier").Range("A65500").End(xlUp).Row + 1
Sheets("Ordonnancier").Cells(derlig, 2).Value = Cells(lig, 2).Value
' tenir compte des 2 colonnes cachées 18 à 24 au lieu de 17 à 23
Sheets("Ordonnancier").Cells(derlig, 3).Value = Cells(lig, 3).Value
Sheets("Ordonnancier").Cells(derlig, 4).Value = Cells(lig, 10).Value
Sheets("Ordonnancier").Cells(derlig, 5).Value = Cells(lig, 9).Value
Sheets("Ordonnancier").Cells(derlig, 6).Value = Cells(lig, 12).Value
Sheets("Ordonnancier").Cells(derlig, 7).Value = Cells(lig, 11).Value
Sheets("Ordonnancier").Cells(derlig, 8).Value = Cells(lig, 20).Value
Sheets("Ordonnancier").Cells(derlig, 9).Value = Cells(lig, 26).Value
Sheets("Ordonnancier").Cells(derlig, 10).Value = Cells(lig, 8).Value
Sheets("Ordonnancier").Cells(derlig, 11).Value = Cells(lig, 21).Value
Sheets("Ordonnancier").Cells(derlig, 12).Value = Cells(lig, 22).Value
Sheets("Ordonnancier").Cells(derlig, 13).Value = Cells(lig, 23).Value
Sheets("Ordonnancier").Cells(derlig, 14).Value = Cells(lig, 24).Value
Sheets("Ordonnancier").Cells(derlig, 15).Value = Cells(lig, 25).Value
Sheets("Ordonnancier").Cells(derlig, 1).Value = ActiveSheet.Name
num1 = Sheets("Ordonnancier").Cells(derlig - 1, 16).Value
Sheets("Ordonnancier").Cells(derlig, 16).Value = num1 + 1
End If
End Sub

Dans la même commande, comment passer de:

If Target.Column = 27 Then
Sheets("Ordonnancier").Cells(derlig, 1).Value = ActiveSheet.Name

à:
If Target.Column = 20 Then
Sheets("Nominatif").Cells(derlig, 1).Value = ActiveSheet.Name,

De telle manière que lorsque les cellules de la colonne 27 seront renseignées, l'information sera copiée dans la feuille "Ordonnancier" et lorsque les cellules de la colonne 20 seront renseignées l'information sera copiée dans la feuille "Nominatif".

Autrement dit comment compléter la première commande qui fonctionne trés bien ou faire une autre commande identique dans la même feuille.

Merci beaucoup.
 
Trier par date Trier par votes
Re : Demande d'aide sur: Private Sub Worksheet_Change

Salut degap05,

A condition bien sur que tes feuilles Ordonnancier et Nominatif soient de meme nature, ca devrait fonctionner (Pas teste).

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig, derlig, num1 As Integer
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Column = 27 Then
lig = Target.Row
derlig = Sheets("Ordonnancier").Range("A65500").End(xlUp).Row + 1
Sheets("Ordonnancier").Cells(derlig, 2).Value = Cells(lig, 2).Value
' tenir compte des 2 colonnes cachées 18 à 24 au lieu de 17 à 23
Sheets("Ordonnancier").Cells(derlig, 3).Value = Cells(lig, 3).Value
Sheets("Ordonnancier").Cells(derlig, 4).Value = Cells(lig, 10).Value
Sheets("Ordonnancier").Cells(derlig, 5).Value = Cells(lig, 9).Value
Sheets("Ordonnancier").Cells(derlig, 6).Value = Cells(lig, 12).Value
Sheets("Ordonnancier").Cells(derlig, 7).Value = Cells(lig, 11).Value
Sheets("Ordonnancier").Cells(derlig, 8).Value = Cells(lig, 20).Value
Sheets("Ordonnancier").Cells(derlig, 9).Value = Cells(lig, 26).Value
Sheets("Ordonnancier").Cells(derlig, 10).Value = Cells(lig, 8).Value
Sheets("Ordonnancier").Cells(derlig, 11).Value = Cells(lig, 21).Value
Sheets("Ordonnancier").Cells(derlig, 12).Value = Cells(lig, 22).Value
Sheets("Ordonnancier").Cells(derlig, 13).Value = Cells(lig, 23).Value
Sheets("Ordonnancier").Cells(derlig, 14).Value = Cells(lig, 24).Value
Sheets("Ordonnancier").Cells(derlig, 15).Value = Cells(lig, 25).Value
Sheets("Ordonnancier").Cells(derlig, 1).Value = ActiveSheet.Name
num1 = Sheets("Ordonnancier").Cells(derlig - 1, 16).Value
Sheets("Ordonnancier").Cells(derlig, 16).Value = num1 + 1
End If
If Target.Column = 20 Then
lig = Target.Row
Sheets("Nominatif").Cells(derlig, 1).Value = ActiveSheet.Name
Sheets("Nominatif").Cells(derlig, 2).Value = Cells(lig, 2).Value
' tenir compte des 2 colonnes cachées 18 à 24 au lieu de 17 à 23
Sheets("Nominatif").Cells(derlig, 3).Value = Cells(lig, 3).Value
Sheets("Nominatif").Cells(derlig, 4).Value = Cells(lig, 10).Value
Sheets("Nominatif").Cells(derlig, 5).Value = Cells(lig, 9).Value
Sheets("Nominatif").Cells(derlig, 6).Value = Cells(lig, 12).Value
Sheets("Nominatif").Cells(derlig, 7).Value = Cells(lig, 11).Value
Sheets("Nominatif").Cells(derlig, 8).Value = Cells(lig, 20).Value
Sheets("Nominatif").Cells(derlig, 9).Value = Cells(lig, 26).Value
Sheets("Nominatif").Cells(derlig, 10).Value = Cells(lig, 8).Value
Sheets("Nominatifr").Cells(derlig, 11).Value = Cells(lig, 21).Value
Sheets("Nominatif").Cells(derlig, 12).Value = Cells(lig, 22).Value
Sheets("Nominatif").Cells(derlig, 13).Value = Cells(lig, 23).Value
Sheets("Nominatif").Cells(derlig, 14).Value = Cells(lig, 24).Value
Sheets("Nominatif").Cells(derlig, 15).Value = Cells(lig, 25).Value
Sheets("Nominatif").Cells(derlig, 1).Value = ActiveSheet.Name
num1 = Sheets("Nominatif").Cells(derlig - 1, 16).Value
Sheets("Nominatif").Cells(derlig, 16).Value = num1 + 1
End If

End Sub

Bonne journee

Olivier
 
Vote positif 0 Vote négatif
Re : Demande d'aide sur: Private Sub Worksheet_Change

Bonjour, merci de ta réponse rapide. Hélas, cela ne fonctionne pas, aprés adaptation de ma part. Cela devrait ressembler à:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig, derlig, num1 As Integer
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Column = 27 Then
lig = Target.Row
derlig = Sheets("Ordonnancier").Range("A65500").End(xlUp).R ow + 1
Sheets("Ordonnancier").Cells(derlig, 2).Value = Cells(lig, 2).Value
Sheets("Ordonnancier").Cells(derlig, 1).Value = ActiveSheet.Name
num1 = Sheets("Ordonnancier").Cells(derlig - 1, 16).Value
Sheets("Ordonnancier").Cells(derlig, 16).Value = num1 + 1

End If
If Target.Column = 20 Then
lig = Target.Row
Sheets("Nominatif").Range("B9").Value = ActiveSheet.Name

End If
End Sub

J'ai volontairement écourté la formule.

Merci.
 
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

Discussions similaires

F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
211
kiki29
kiki29
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
Nicolas JACQUIN
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
532
CortoXls
C
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
275
KRUG WOO
K
C
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
184
CDALE
C
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
940
laurent950
laurent950
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
334
thunder23
thunder23
A
  • Résolu(e)
XL 2010 Private Sub Worksheet_Change
Réponses
2
Affichages
294
Atlas85200
A
lestoiles1
  • Question Question
XL 2013 Sub commentaire
Réponses
2
Affichages
162
lestoiles1
lestoiles1
M
  • Question Question
Microsoft 365 Modifier code et format textbox
2 3
Réponses
35
Affichages
2 K
Marvin57
M
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
262
sebastien176
S
VBA_dev_Anne_Marie
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
364
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
705
Gestionnaire_rh
G
Amigo
  • Question Question
XL 2016 Protéger Plage avec condition
2
Réponses
16
Affichages
1 K
Amigo
Amigo
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
348
Latias
L
D
  • Question Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
2 K
Dranreb
Dranreb
yojema
  • Question Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
513
Dranreb
Dranreb
S
  • Question Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
470
souhaib ad
S
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
1 K
Phil69970
Phil69970
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
1 K
Vermithor
V
Retour