Macro événementielle à placer dans ThisWorkbook

[cibleo]

Bonsoir le forum,

J'aimerais savoir si je pouvais modifier cette macro événementielle pour la placer dans ThisWorkbook.

Celle-ci est placée dans la fenêtre de code de ma feuille de calcul "Encais Janv09" et me permet de faire un copier coller de données saisies dans cette feuille vers ma feuille "Caisse Janv09".

Or mon fichier est composé de 12 feuilles identiques nommées ainsi Encais Janv09" , Encais Fev09 , Encais Mars09 etc... jusqu'à Encais Dec09.

J'ai donc copié 12 fois cette macro en changeant ce qui est mentionné en orange dans le code ci-dessous pour pouvoir effectuer mes copier coller vers mes feuilles Caisse Janv09 , Caisse Fev09 , Caisse Mars09 etc... jusqu'à Caisse Dec09.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E2:E200")) Is Nothing Then
If Target.Value <> "" Then
With Sheets("Caisse Janv09")
LigVide = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & LigVide).Value = Range("A" & Target.Row).Value
.Range("B" & LigVide).Value = Range("C" & Target.Row).Value
.Range("E" & LigVide).Value = Range("E" & Target.Row).Value
End With
End If
End If
End Sub

N'y a t-il pas un moyen d'écrire qu'une seule et unique macro pour la placer dans ThisWorkbook en lieu et place des 12 créées pour chaque feuille.
Si oui, quel événement choisir ?

Merci de votre aide Cibleo

 

[Compte Supprimé 979]

Re : Macro événementielle à placer dans ThisWorkbook

Salut Cibleo,

Utilise ce code à mettre dans ThisWorkbook

Option Explicit
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim LigVide As Long, VMois As String
  ' Vérifier si la feuille est une feuille : Encais xxx
  If Left(Sh.Name, 6) = "Encais" Then
    ' Tester si saisie dans la bonne colonne
    If Not Intersect(Target, Range("E4:E42")) Is Nothing Then
      If Target.Value <> "" Then
        ' Récupérer la valeur du mois
        VMois = Mid(Sh.Name, InStr(1, Sh.Name, " ") + 1, 255)
        With Sheets("Caisse " & VMois)
          LigVide = .Range("A" & Rows.Count).End(xlUp).Row + 1
          .Range("A" & LigVide).Value = Range("A" & Target.Row).Value
          .Range("B" & LigVide).Value = Range("C" & Target.Row).Value
          .Range("E" & LigVide).Value = Range("E" & Target.Row).Value
        End With
      End If
    End If
  End If
End Sub

N'oublie pas de supprimer le code dans tes feuilles 😉

A+

 

[Pierrot93]

Re : Macro événementielle à placer dans ThisWorkbook

Bonjour Cbleo

essaye comme ceci, la variable "sh" étant la feuillle sur laquelle le changement est effectué, te permet éventuellement d'exclure certaines feuilles :

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("E2:E200")) Is Nothing Then
    If Target.Value <> "" Then
        With Sh
            LigVide = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("A" & LigVide).Value = Range("A" & Target.Row).Value
            .Range("B" & LigVide).Value = Range("C" & Target.Row).Value
            .Range("E" & LigVide).Value = Range("E" & Target.Row).Value
        End With
    End If
End If
End Sub

bonne soirée
@+

Aarf, bonsoir Bruno, désolé pour la collision...

 

[cibleo]

Re : Macro événementielle à placer dans ThisWorkbook

Bonsoir Bruno,
Bonsoir Pierrot,

Je teste tout çà ce week-end et vous rend réponse début de semaine prochaine.

J'aime bien quand il y a quelques commentaires, c'est tout de suite beaucoup plus clair pour moi, je crois comprendre qu'il faut que je fasse bien attention pour récupérer la valeur du mois.

Mais bon, c'est pas demain la veille, que j'arriverai à transcrire toutes ces lignes de code.

Mille mercis à vous deux et bon week-end.

Amicalement Cibleo

 

[cibleo]

Re : Macro événementielle à placer dans ThisWorkbook

Bonsoir à tous,

Voilà, j'ai testé, ton code fonctionne à merveille Bruno.

Par contre Pierrot, il fonctionne mais cela ne répond pas à ma demande.
En fait, il me copie la ligne que je saisis dans la feuille "Encais" jusqu'à la ligne 200.

J'ai une autre demande similaire.

J'ai récuperé le code événementiel ci-dessous que j'ai placé dans la fenêtre de code de ma feuille "Caisse Janv09" qui fonctionne à merveille.
Principe : lors de ma saisie, le retour à la ligne se fait directement dans la 1ère cellule vide de la colonne A quand j'atteinds la colonne E.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ligne As Integer
If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
Ligne = Target.Row + 1
Range("A" & Ligne).Activate
End If
End Sub

Et j'aimerais le modifier pour le mettre dans ThisWorkbook pour éviter de le copier 12 fois dans le module de mes feuilles de calcul commençant par "Caisse".
A la manière de Bruno ci-dessus, j'ai fait une tentative ci-dessous mais cela ne fonctionne pas.

Est-ce le bon événement, si oui dois je le combiner avec le code de Bruno ci-dessus puisque j'aurais 2 événements "SheetChange" dans ThisWorkbook ?

Comme vous le voyez je suis en plein apprentissage 🙄

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Ligne As Integer
If Left(Sh.Name, 6) = "Caisse" Then
If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
Ligne = Target.Row + 1
Range("A" & Ligne).Activate
End If
End If
End Sub

Merci de vore aide Cibleo

 

[Compte Supprimé 979]

Re : Macro événementielle à placer dans ThisWorkbook

Salut Cibleo,

L'évènement : Workbook_SheetSelectionChange
ce produit à chaque fois que tu changes de cellule

L'évènement : Workbook_SheetChange
ce produit à chque fois que tu changes le contenu d'une cellule

Donc après tout dépend de ce que tu veux !?

Avec mon précédent code, cela donne :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim LigVide As Long, Ligne As Long, VMois As String
[B][COLOR=blue]  ' Empècher les évènements de se reproduire
  Application.EnableEvents = False[/COLOR][/B]
  ' Vérifier si la feuille est une feuille : Encais xxx
  If Left(Sh.Name, 6) = "Encais" Then
    ' Tester si saisie dans la bonne colonne
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
      If Target.Value <> "" Then
        ' Récupérer la valeur du mois
        VMois = Mid(Sh.Name, InStr(1, Sh.Name, " ") + 1, 255)
        With Sheets("Caisse " & VMois)
          LigVide = .Range("A" & Rows.Count).End(xlUp).Row + 1
          .Range("A" & LigVide).Value = Range("A" & Target.Row).Value
          .Range("B" & LigVide).Value = Range("C" & Target.Row).Value
          .Range("E" & LigVide).Value = Range("E" & Target.Row).Value
        End With
      End If
    End If
  End If
  ' Vérifier si la feuille est une feuille : Caisse xxx
  If Left(Sh.Name, 6) = "Caisse" Then
    If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
      Ligne = Target.Row + 1
      Range("A" & Ligne).Select
    Else
      Target.Offset(0, 1).Select
    End If
  End If
[B][COLOR=blue]  ' Réactiver les évènements
  Application.EnableEvents = True[/COLOR][/B]
End Sub

A+

 

[cibleo]

Re : Macro événementielle à placer dans ThisWorkbook

Bonsoir Bruno et merci de me répondre

J'ai une erreur d'exécution '1004' avec la ligne ci-dessous :

La méthode 'Intersect' de l'objet 'Application' a échoué !

If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then

Sinon l'événement me convient, j'ai compris que pour un même événement on ne pouvait pas écrire 2 procédures distinctes, il faut tout combiner dans la même.

Je refais des tests pour voir s'il n'y a pas d'erreur de ma part dans le collage de ton code.

Cibleo

 

[Compte Supprimé 979]

Re : Macro événementielle à placer dans ThisWorkbook

Re,

Effectivement il y a comme un GROS bug 😀

Regarde le code modifié de mon post précédent.

J'ai ajouté : Application.EnableEvents
Au début et à la fin de la procédure

Car comme ta ligne est copiée lors d'une saisie dans "Encais xxx"
cela entraine le même évènement dans la feuille "Caisse xxxx", alors que tu n'y ai pas, d'où l'erreur 1004

A+

 

[cibleo]

Re : Macro événementielle à placer dans ThisWorkbook

Re Bruno,

Y a plus de bug mais le problème c'est que ma macro événementielle de ma nouvelle demande ne fonctionne pas 😕

Fais une saisie dans la feuille "Caisse Janv09" et valide un montant dans la colonne débit, le curseur devrait se retrouver dans la première cellule vide de la colonne A, un retour chariot en quelque sorte.

Initialement, la macro événementielle que j'avais placé dans le module de la feuille de calcul fonctionnait bien.

Je te joins mon fichier avec ton code dans ThisWorkbook, j'ai enlevé celle qui était placée dans la feuille "Caisse Janv09".

Je fatigue, j'arrête pour aujourd'hui.

Bonnne soirée à tous Cibleo

 

[cibleo]

Re : Macro événementielle à placer dans ThisWorkbook

Bonsoir à tous,
Bonsoir Bruno,

Simplement pour vous signaler que j'ai rectifié le tir en changeant d'événement et choisi SheetSelectionChange.

Pour rappel, je cherchais une solution pour faire un retour chariot en colonne A lorsque ma dernière saisie était validée en colonne D dans mes feuilles "Caisse" et G dans celles nommées "Encais".

Après une bonne nuit de sommeil 🙄, j'ai écrit et testé le code ci-dessous et cela fonctionne.

Si vous trouvez que les instructions sont mal ordonnées ou s'il y a quelques modifications à apporter n'hésitez pas à me le faire savoir.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim Ligne As Integer
  If Left(Sh.Name, 6) = "Caisse" Then
    If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then
      Ligne = Target.Row + 1
      Range("A" & Ligne).Activate
    End If
  End If
  If Left(Sh.Name, 6) = "Encais" Then
    If Not Application.Intersect(Target, Range("H:H")) Is Nothing Then
      Ligne = Target.Row + 1
      Range("A" & Ligne).Activate
    End If
  End If
End Sub

Sinon, Bruno je n'avais pas compris la signification de ceci dans ton code précédant, dois-je le rajouter ?

Else
      Target.Offset(0, 1).Select

A+ Cibleo