Discussion :

[Imperium]

Bonjour à tous,

Voilà, un ami m'a réalisé cette macro :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$5" Then Exit Sub
Target.ColumnWidth = 30
Target.Offset(1).RowHeight = 12.75
Target.Offset(1).Clear
On Error Resume Next
With Workbooks("CONTRATS_BASE.xls").Sheets(Target.Value).Range("B2")
If Err Then Exit Sub
.Copy Target.Offset(1)
Target.ColumnWidth = .ColumnWidth
Target.Offset(1).RowHeight = .RowHeight
End With
Target.Select
End Sub

Celle-ci a pour effet de recopier le contenu d'une cellule B2 située sur un autre onglet du mêmeclasseur, en fonction du choix fait sur une liste déroulante située en B5.

Bref, jusque là tout va bien ^^, sauf que j'aimerai que cette macro s'execute également lorsque je fais un choix sur une liste située en B11 (et encore plus tard une autre en B15.)

Comme un malin, j'ai recopié la macro à la suite en changeant juste la 2ème ligne, ce qui m'a donné quelque chose comme ça :

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
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$5" Then Exit Sub
Target.ColumnWidth = 30
Target.Offset(1).RowHeight = 12.75
Target.Offset(1).Clear
On Error Resume Next
With Workbooks("CONTRATS_BASE.xls").Sheets(Target.Value).Range("B2")
If Err Then Exit Sub
.Copy Target.Offset(1)
Target.ColumnWidth = .ColumnWidth
Target.Offset(1).RowHeight = .RowHeight
End With
Target.Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$11" Then Exit Sub
Target.ColumnWidth = 30
Target.Offset(1).RowHeight = 12.75
Target.Offset(1).Clear
On Error Resume Next
With Workbooks("CONTRATS_BASE.xls").Sheets(Target.Value).Range("B2")
If Err Then Exit Sub
.Copy Target.Offset(1)
Target.ColumnWidth = .ColumnWidth
Target.Offset(1).RowHeight = .RowHeight
End With
Target.Select
End Sub

Mais lorsqu'elle s'execute, il se passe "erreur de compilation, nom ambigu détecté worksheet change".

Que faut-il que je fasse ?

Merci beaucoup pour votre aide !

[mayekeul]

bonjour

et bonne année

effectivement tu lui défini deux fois la même procédure (eele ont toute les deux le même nom)

mais attention, ce sont ici des événement donc un seul se déclenchera
celui qui gardera comme intitulé

Code :

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

private sub worksheet_change

et non plus le deuxième que tu dois renommer

[Imperium]

Merci pour cette réponse, mais justement, en quoi dois-je le renommer pour que celui marche ?
Si tu as une procédure plus détaillée ?

[mayekeul]

comme ceci

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
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B5,B11")) Is Nothing Then
    Target.ColumnWidth = 30
    Target.Offset(1).RowHeight = 12.75
    Target.Offset(1).Clear
    On Error Resume Next
    With Workbooks("CONTRATS_BASE.xls").Sheets(Target.Value).Range("B2")
        If Err Then Exit Sub
        .Copy Target.Offset(1)
        Target.ColumnWidth = .ColumnWidth
        Target.Offset(1).RowHeight = .RowHeight
    End With
    Target.Select
End If
End Sub

[wilfried_42]

Bonjour

Les 2 procedures doivent en devir une seule, il n'exite qu'une procedure d'interuption par type d'interruption

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
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$5" or Target.Address = "$B$11" Then 
    Target.ColumnWidth = 30
    Target.Offset(1).RowHeight = 12.75
    Target.Offset(1).Clear
    On Error goto erreur
    With Workbooks("CONTRATS_BASE.xls").Sheets(Target.Value).Range("B2")
        .Copy Target.Offset(1)
         Target.ColumnWidth = .ColumnWidth
         Target.Offset(1).RowHeight = .RowHeight
     End With
    Target.Select
end if
erreur:
on error goto 0
End Sub

[Imperium]

Et... ça marche ! Merci beaucoup pour ton aide, c'est génial

[mercierlc]

Voici les deux codes que je veux faire fonctionner simultanément de façon à ce que chaque saisie de donnée soit renvoyée automatiquement à la ligne suivante dans le but d'éviter que chaque nouvelle entrée efface la précédente!
Quelqu'un saurait comment l'écrire convenablement pour que le tout fonctionne?

Code # 1

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub btnCREATE_Click()
Range("A2").Value = txtCUP.Text
Range("B2").Value = txtSKU.Text
Range("C2").Value = txtKEY.Text
Range("D2").Value = txtDESC.Text
Range("E2").Value = txtCST.Text
Range("F2").Value = txtPRX.Text
Range("G2").Value = txtDEPT.Text
Range("H2").Value = txtPGE.Text
 
End Sub

Code # 2

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub btnCREATE_Click()
Range("A2").Select
ActiveCell.End(xlDown).Select
lastrow = ActiveCell.Row
MsgBox = lastrow
Cells(lastrow + 1, 1).Value = txtCUP.Text
 
 
End Sub

Merci à l'avance et mes salutations!

[wahid-chaoui]

j'ai un fichier et je veux entrer deux code vba sur la même page
le 1er c'est pour transfère des données a une autre feuil
le 2eme c'est pour la siasi intuitive dans combobox

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
31
32
33
34
35
36
37
38
39
40
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("d4")) Is Nothing Then
If [a2] = 1 Then
Application.ScreenUpdating = False
If Target.Text = "ãÈíÚÇÊ" Then  '---------------------------
 Range("H4").Validation.Delete
 Range("H4").Validation.Add Type:=xlValidateList, Formula1:="=seller"
 [d5] = Application.WorksheetFunction.Max(Sheet3.Range("b5:b10000")) + 1
End If
If Target.Text = "ãÔÊÑíÇÊ" Then
[a1] = 2
 Range("H4").Validation.Delete
 Range("H4").Validation.Add Type:=xlValidateList, Formula1:="=buyer"
  [d5] = Application.WorksheetFunction.Max(Sheet4.Range("b5:b10000")) + 1
End If
End If
If Target.Text = "ãÈíÚÇÊ" Then [a1] = 3
If Target.Text = "ãÔÊÑíÇÊ" Then [a1] = 2
End If
If Not Intersect(Target, Range("h4:i4")) Is Nothing Then
If Range("d4").Text = "ãÈíÚÇÊ" Then  '---------------------------
 Range("f5") = Application.WorksheetFunction.VLookup(Target, Sheet1.Range("q5:s5000"), 2, 0)
 Range("h5") = Application.WorksheetFunction.VLookup(Target, Sheet1.Range("q5:s5000"), 3, 0)
End If
If Range("d4").Text = "ãÔÊÑíÇÊ" Then  '---------------------------
 Range("f5") = Application.WorksheetFunction.VLookup(Target, Sheet1.Range("t5:v5000"), 2, 0)
 Range("h5") = Application.WorksheetFunction.VLookup(Target, Sheet1.Range("t5:v5000"), 3, 0)
End If
If [h4] = "" Then Range("f5") = ""
If [h4] = "" Then Range("h5") = ""
 
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("e8:g32,b8:b32,f5,h5")) Is Nothing Then Cells(Target.Row, 1).Select
If Not Intersect(Target, Range("f4")) Is Nothing And [a2] = 1 Then UserForm1.Show
If Not Intersect(Target, Range("f4,h4")) Is Nothing And [a2] = 2 Then Cells(Target.Row, 1).Select
If Not Intersect(Target, Range("d5")) Is Nothing And [a2] = 1 Then Cells(Target.Row, 1).Select
End Sub

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
31
32
33
34
35
36
37
38
39
40
41
42
43
 
Dim a(), mémo, f
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set f = Sheets("data")
  Set zSaisie = Range("C8:C32")
  If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
    If mémo <> "" Then If IsError(Application.Match(Range(mémo), a, 0)) Then Range(mémo) = ""
    a = Application.Transpose(f.Range("b2:b" & f.[B65000].End(xlUp).Row))
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = Target.Height + 3
    Me.ComboBox1.Width = Target.Width
    Me.ComboBox1.Top = Target.Top
    Me.ComboBox1.Left = Target.Left
    Me.ComboBox1 = Target
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    mémo = Target.Address
  Else
    Me.ComboBox1.Visible = False
  End If
End Sub
Private Sub ComboBox1_Change()
  If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
    Set d1 = CreateObject("Scripting.Dictionary")
    tmp = UCase(Me.ComboBox1) & "*"
    For Each c In a
      If UCase(c) Like tmp Then d1(c) = ""
    Next c
    Me.ComboBox1.List = d1.keys
    Me.ComboBox1.DropDown
  End If
  ActiveCell.Value = Me.ComboBox1
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  ComboBox1.List = Application.Transpose(f.Range("b5:b" & f.[B65000].End(xlUp).Row))
  Me.ComboBox1.DropDown
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 13 Then
    If IsError(Application.Match(ActiveCell, a, 0)) Then ActiveCell = ""
    ActiveCell.Offset(1).Select
  End If
End Sub

[EstRM]

Bonjour,

Même problème pour moi sauf que je n'utilise pas Target.Adress donc je ne vois pas comment faire.. j'ai fais des essais infructueux...

Code :

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

1
2
3
4
5
6
7
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [D54:G60]) Is Nothing And Target.Count = 1 Then
    Saisie.Show
    Application.Wait Now() + TimeValue("0:0:1")
    Saisie.Hide
End If
End Sub

Je voudrais que Saisie marche également pour C6470 ainsi que E131:H137....

Merci pour votre aide,
ERM.