Copie USF vers onglet

**vmax67** · 23/01/2010, 00h05

Bonsoir
J’aimerai finaliser mon application, mais je bute sur la maj des données saisies

1.Les valeurs saisies dans la USF ne se copient pas dans l’onglet correspondant à la valeur de la combobox1 (V1 = nom combo1)
et de la combobox2 (P2 = nom combo2)

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
Sub MAJ()
Dim i As Byte, Nom As String, DerLig As Long
Dim Dum As String, Longueur As Integer
 
Nom = V1.Value ' = Valeur de la Combobox1
Dum = Right(Nom, 2)
Longueur = Len(Nom)
Nom = Mid(Nom, 1, (Longueur - 4))
Nom = Nom & Dum
Nom = LCase(Nom)
Nom = Trim(Nom)
Dum = UCase(Left(Nom, 1))
Nom = Dum & Mid(Nom, 2)
 
With Sheets(Nom)
DerLig = .Range("A65536").End(xlUp).Row + 1
.Cells(DerLig, 1) = V1
.Cells(DerLig, 2) = TextBox5
.Cells(DerLig, 3) = TextBox6
.Cells(DerLig, 4) = Combobox7
.Cells(DerLig, 5) = ComboBox10a
 
End With
End Sub

Attention il y a

un espace dans le nom des onglets.
Exemple: Dupont Paul, Dupont Jean, Dupont Claude.

Merci pour votre collaboration

Vmax

**Qwazerty** · 23/01/2010, 08h06

Salut
Pas facile de dire sans pouvoir exécuter, tu n'as aucun message d'erreur? La construction de la variable Nom me parait plutôt bizarre, je vois pas comment au final elle pourrait contenir "Dupont Paul".
Donne nous le contenu de V1 au départ de ta procédure.
Dans ta question tu parles de P2, mais je ne le vois apparaitre nul part dans ton code.

Juste une remarque syntaxique, plutot que

Code :

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

DerLig = .Range("A65536").End(xlUp).Row + 1

préfère

Code :

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

DerLig = .cells(rows.count,"A").End(xlUp).Row + 1

++
Qwaz

**vmax67** · 23/01/2010, 11h46

Bonjour

Voici le code :

Vous avez raison pour P2, mais je ne sais pas comment faire pour l'intégrer dans le code

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Private Sub UserForm_Initialize()
 
Dim S As Worksheet
Dim R As Range
Dim T()
Dim var
Dim i&
Dim C As Control
On Error GoTo Erreur
Set S = Sheets(MA_FEUILLE)
Set R = S.Range("b" & LIG_DEPART & ":b" & S.[b65536].End(xlUp).Row & "")
ReDim T(1 To R.Rows.Count, 1 To 2)
var = R
For i& = 1 To UBound(T, 1)
  T(i&, 1) = i&
  T(i&, 2) = var(i&, 1)
Next i&
Set S = Nothing
Set S = Sheets.Add
Set R = S.Range("a1:b" & UBound(T, 1) & "")
R = T
R.Sort key1:=S.[b1], order1:=xlAscending
var = S.Range(R.Address)
With Application
  .ScreenUpdating = False
  .DisplayAlerts = False
End With
With V1
  .ColumnCount = 2
  .ColumnWidths = "0;50"
  .List = var
  .SetFocus
End With
With P2
  .ColumnCount = 2
  .ColumnWidths = "0;50"
  .List = var
End With
For Each C In Me.Controls
  If TypeName(C) = "TextBox" Then
    With C.Font
      If NUM_vs_NOM Then
        .Size = 16
      Else
        .Size = 8
      End If
    End With
  End If
Next C
Erreur:
If Not S Is Nothing Then S.Delete
With Application
  .DisplayAlerts = True
  .ScreenUpdating = True
End With
End Sub
 
 
Private Sub OK_Click()
    Dim S As Worksheet
Dim S2 As Worksheet
Dim R As Range
Dim ligne1&
Dim ligne2&
If TextBox1 = "" Or TextBox2 = "" Then Exit Sub
If TextBox1 = TextBox2 Then Exit Sub
If TextBox10a.Value = "B" Then
   MATCHNULL
End If
On Error GoTo Erreur
Set S = Sheets(MA_FEUILLE)
ligne1& = V1.Column(0, V1.ListIndex) + LIG_DEPART - 1
ligne2& = P2.Column(0, P2.ListIndex) + LIG_DEPART - 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set S2 = Sheets.Add
Set R = S.Rows(ligne1&)
R.Cut Destination:=S2.Rows(1)
Set R = S.Rows(ligne2&)
R.Cut Destination:=S2.Rows(2)
Set R = S2.Rows(1)
R.Cut Destination:=S.Rows(ligne2&)
Set R = S2.Rows(2)
R.Cut Destination:=S.Rows(ligne1&)
Erreur:
If Not S2 Is Nothing Then S2.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("A3:A5").Select
    Selection.AutoFill Destination:=Range("A3:A35"), Type:=xlFillDefault
    Range("D40").Select
 
Range("A1").Select
 
Unload Me
End Sub
 
Private Sub V1_Change()
With V1
  If .ListIndex = -1 Then Exit Sub
  If NUM_vs_NOM Then
    TextBox1.Value = .Column(0, .ListIndex) + LIG_DEPART - 3
    TextBox3.Value = .Column(0, .ListIndex) + LIG_DEPART - 3
    TextBox5 = Sheets("Tableau").Range("c" & V1.Column(0, V1.ListIndex) + 2)
    TextBox10 = Sheets("Tableau").Range("c" & V1.Column(0, V1.ListIndex) + 2)
    TextBox11 = CDbl(TextBox5) - CDbl(TextBox10)
 
  Else
    TextBox1.Value = .Column(1, .ListIndex)
    TextBox3.Value = .Column(1, .ListIndex)
  End If
End With
End Sub
 
Private Sub P2_Change()
With P2
  If .ListIndex = -1 Then Exit Sub
  If NUM_vs_NOM Then
    TextBox2.Value = .Column(0, .ListIndex) + LIG_DEPART - 3
    TextBox4.Value = .Column(0, .ListIndex) + LIG_DEPART - 3
    TextBox8 = Sheets("Tableau").Range("c" & P2.Column(0, P2.ListIndex) + 2)
    TextBox20 = Sheets("Tableau").Range("c" & P2.Column(0, P2.ListIndex) + 2)
    TextBox21 = CDbl(TextBox8) - CDbl(TextBox20)
 
  Else
    TextBox2.Value = .Column(1, .ListIndex)
    TextBox4.Value = .Column(1, .ListIndex)
  End If
End With
End Sub