Discussion :

['OTM']

Bonjour à toutes et à tous,

Je suis débutant, je travaille avec une macro qui toune à merveille, j'aimerai simplement ajouter en copie la feuille2 de cette macro puis une "Target"en "AF"et copier ma nouvelle sélection en feuille3.
et vérouiller par le même mot de passe mes feuilles (1,3, base). mais c'est pas facile pour un débutant.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub Worksheet_Change(ByVal Target As Range)
        If Intersect(Target, Columns("AE")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
        ActiveSheet.Unprotect Password:="TEST"
        Dim sheetTemp As Worksheet
        Dim sheetToPaste As Worksheet
        Dim rng As Range
 
        If Target <> "" Then
            Range("J" & Target.Row).Value = Now()
            Application.Union(Range("A" & Target.Row & ":E" & Target.Row), Range("J" & Target.Row & ":J" & Target.Row), Range("X" & Target.Row & ":X" & Target.Row), Range("AD" & Target.Row & ":AE" & Target.Row), Range("AG" & Target.Row & ":AN" & Target.Row)).SpecialCells(xlCellTypeVisible).Select
            Selection.Copy
            Set sheetTemp = ActiveSheet
            Set sheetToPaste = Worksheets("Feuil1")
            sheetToPaste.Activate
            lastRow = sheetToPaste.Columns(1).Find(What:="*", SearchDirection:=xlPrevious).Row
            sheetToPaste.Range("A" & lastRow + 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Set rng = sheetToPaste.Range("A2", "Q" & lastRow + 2)
            rng.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17), Header:=xlNo
            sheetTemp.Activate
                    Range("a" & Target.Row).Resize(1, 40).Locked = True
        Else
            Range("a" & Target.Row).Resize(1, 40).Locked = False
 
 
        End If
            ActiveSheet.Protect Password:="TEST"
 
 
End Sub

Merci de votre précieuse aide

[Daniel.C]

Bonjour,

Pas sûr d'avoir bien compris. Ton code pourrait s'articuler comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 31 And Target.Cells.Count = 1 Then '(Target.Count = 1 le fait aussi)
    'ton code
ElseIf Target.Column = 32 And Target.Cells.Count = 1 Then
    'ton code
End If

et, pour les mots de passe :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sheets("1").Protect Password:="TEST"
Sheets("3").Protect Password:="TEST"
Sheets("base").Protect Password:="TEST"

['OTM']

Re bonjour Daniel,

j'ai malheureusement erreur de compilation "Else sans IF"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ElseIf Target.Column = 32 And Target.Cells.Count = 1 Then.

J'espère avoir bien compris , ci joint le code mis à jour.

Bloc note.txt

Cdt

[Daniel.C]

Oui ça a l'air d'être bon.

['OTM']

Bien malheureusement erreur de compilation "Else sans IF", sur la seconde partie du code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ElseIf Target.Column = 32 And Target.Cells.Count = 1 Then

[Daniel.C]

Il manque un "End If" avant le ElseIf :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
    If Target <> "" Then
        Range("J" & Target.Row).Value = Now()
        Application.Union(Range("A" & Target.Row & ":E" & Target.Row), Range("J" & Target.Row & ":J" & Target.Row), Range("X" & Target.Row & ":X" & Target.Row), Range("AD" & Target.Row & ":AE" & Target.Row), Range("AG" & Target.Row & ":AN" & Target.Row)).SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        Set sheetTemp = ActiveSheet
        Set sheetToPaste = Worksheets("Feuil1")
        sheetToPaste.Activate
        lastRow = sheetToPaste.Columns(1).Find(What:="*", SearchDirection:=xlPrevious).Row
        sheetToPaste.Range("A" & lastRow + 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Set rng = sheetToPaste.Range("A2", "Q" & lastRow + 2)
        rng.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17), Header:=xlNo
        sheetTemp.Activate
        Range("a" & Target.Row).Resize(1, 40).Locked = True
     Else
     Range("a" & Target.Row).Resize(1, 40).Locked = False
'******************** ICI***************************************
ElseIf Target.Column = 32 And Target.Cells.Count = 1 Then