cohabitation de 2 macros

[CAFRINE]

Bonjour à toutes et à tous

aujourd'hui, je voudrais utiliser deux "Private Sub Worksheet_Change(ByVal Target As Range)", et bien sur
j'ai un message d'erreur : Erreur de compilation
j'ai fais un collage : mais cela fait actionner plusieurs fois la 1ere macro, "je crois"
1ere macro = format minuscule/majuscule à l'insertion des données.
2ème macro = couper/coller ligne sur autre feuille si x

>>


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("B5:B500")) Is Nothing Then
Target = UCase(Target)
End If
If Not Intersect(Target, Range("C5:C500")) Is Nothing Then
Target = LCase(Target)
End If
End Sub





'Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As String
Dim nblig As String
Dim DerLigne As String
Dim i As Byte

ActiveSheet.Unprotect
Application.Volatile
Application.ScreenUpdating = False
On Error Resume Next
If Left(Target.Address, 2) = "$M" Then
If Target.Value = "X" Or Target.Value = "x" Then
lig = Target.Row
nblig = Sheets("Archives").Range("B65535").End(xlUp).Row + 1
For i = 2 To 14
Sheets("Archives").Cells(nblig, i).Value = Cells(lig, i).Value
Next i
Rows(lig).Delete Shift:=xlUp

End If
End If

Sheets("Saint").Cells(1, 1).Activate
Application.ScreenUpdating = True
Sheets("Archives").Range("a65535").End(xlUp) = Now
ActiveSheet.Protect
End Sub


je vous remercie de votre aide
Cordialement
Cafrine

 

[Pierrot93]

Re : cohabitation de 2 macros

Bonjour,

tu ne peux avoir qu'une seule procédure par type d'événement dans un module de feuille, soit qu'une seule procédure "Worksheet_Change", il te faut regrouper ton code dans une seule "sub".

bon après midi
@+

 

[CAFRINE]

Re : cohabitation de 2 macros

bonjour pierrot93,

merci de ta réponse
oui, çà je l'avais comprise et essayé de le faire....
mais je suis très limitée dans ce domaine..

Cordialement

 

[Pierrot93]

Re : cohabitation de 2 macros

Re,

regarde ceci, la feuille ne doit pas être protégée... code non testé

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim lig As String
 Dim nblig As String
 Dim DerLigne As String
 Dim i As Byte
 On Error GoTo fin
 Application.EnableEvents = False
 If Not Intersect(Target, Range("B5:B500")) Is Nothing Then
 Target = UCase(Target)
 End If
 If Not Intersect(Target, Range("C5:C500")) Is Nothing Then
 Target = LCase(Target)
 End If

 If Left(Target.Address, 2) = "$M" Then
    If Target.Value = "X" Or Target.Value = "x" Then
    lig = Target.Row
    nblig = Sheets("Archives").Range("B65535").End(xlUp).Row + 1
    For i = 2 To 14
    Sheets("Archives").Cells(nblig, i).Value = Cells(lig, i).Value
    Next i
    Rows(lig).Delete Shift:=xlUp
    End If
 End If
fin:
 Application.EnableEvents = True
 End Sub

Edition : bonjour Jean-Claude

 

[JCGL]

Re : cohabitation de 2 macros

Bonjour à tous,
Salut Pierrot,

Avec la Protection :

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lig As String
    Dim nblig As String
    Dim DerLigne As String
    Dim i As Byte


    ActiveSheet.Unprotect


    On Error Resume Next
    If Not Intersect(Target, Range("B5:B500")) Is Nothing Then Target = UCase(Target)
    If Not Intersect(Target, Range("C5:C500")) Is Nothing Then Target = LCase(Target)


    Application.Volatile
    Application.ScreenUpdating = False
    On Error Resume Next
    If Left(Target.Address, 2) = "$M" Then
        If Target.Value = "X" Or Target.Value = "x" Then
            lig = Target.Row
            nblig = Sheets("Archives").Range("B65535").End(xlUp).Row + 1
            For i = 2 To 14
                Sheets("Archives").Cells(nblig, i).Value = Cells(lig, i).Value
            Next i
            Rows(lig).Delete Shift:=xlUp


        End If
    End If


    Sheets("Saint").Cells(1, 1).Activate
    Application.ScreenUpdating = True
    Sheets("Archives").Range("a65535").End(xlUp) = Now
    ActiveSheet.Protect
End Sub

A + à tous

 

[CAFRINE]

Re : cohabitation de 2 macros

suite,
Pierrot93, ton code fonctionne à merveille
mais si je peux me permettre :
avec la feuille source protégée j'ai essayé çà mais mais en vain.
aurais-tu une solution...

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As String
Dim nblig As String
Dim DerLigne As String
Dim i As Byte
On Error GoTo fin
ActiveSheet.Protect
Application.EnableEvents = False
If Not Intersect(Target, Range("B5:B500")) Is Nothing Then
Target = UCase(Target)
End If
If Not Intersect(Target, Range("C5:C500")) Is Nothing Then
Target = LCase(Target)
End If

If Left(Target.Address, 2) = "$M" Then
If Target.Value = "X" Or Target.Value = "x" Then
lig = Target.Row
nblig = Sheets("Archives").Range("B65535").End(xlUp).Row + 1
For i = 2 To 14
Sheets("Archives").Cells(nblig, i).Value = Cells(lig, i).Value
Next i
Rows(lig).Delete Shift:=xlUp
End If
End If
fin:
Application.EnableEvents = True
ActiveSheet.Unprotect
End Sub


merci

 

[CAFRINE]

Re : cohabitation de 2 macros

re,

trop lente à la détente ; je suis désolée
merci à vous deux : c'est impeccable
bonne soirée
cafrine