Renommer un tableau reference en Vba

**pimpom81** · 04/04/2016, 12h37

Bonjour a toutes et tous.

Mon projet consiste a dupliquer un onglet "--Template--" contenant un tableau reference "Template" via un userform.
Mon probleme se situe lorsque je souhaite renommer le tableau dans l'onglet copie avec la valueur de mon Textbox.

J'ai prevu une action de remplacement des espaces par "_".
Ci dessous la partie du code en question.

Code :

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

1
2
3
4
5
6
7
8
9
10
'Add a new tab
    Sheets("--Template--").Select 'Sélection de l'onglet "Template"
    Sheets("--Template--").Copy After:=Sheets(5)
    Sheets("--Template-- (2)").Select
    Sheets("--Template-- (2)").Name = TxtBox_Training.Value
    Range("B1") = TxtBox_Training.Value
    Range("B1").Replace What:=" ", Replacement:="_", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.ListObjects("").Name = Range("B1").Value

Et la, l'ensemble du code pour vous donner une idee globale.

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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
Private Sub UserForm_Initialize()
End Sub
Private Sub CdB_Ok_Click()
Dim nb_column1 As Long, nb_column2 As Long, New_WS As String
    nb_column1 = Worksheets("Employees List").UsedRange.Columns.Count
    nb_column2 = Worksheets("Training Hours").UsedRange.Columns.Count
 
    Application.ScreenUpdating = False
 
'Activate "Training List" sheet
With Worksheets("Training List").Activate
    ActiveSheet.Unprotect
 
    'Insert row under copied row
        Rows("10:12").Select
        Selection.EntireRow.Hidden = False
        Rows("11:11").Select
        Selection.Copy
        Rows("12:12").Select
        Selection.Insert Shift:=xlDown
        Range("B12").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = TxtBox_Training.Value
End With
 
'Add a new tab
    Sheets("--Template--").Select 'Sélection de l'onglet "Template"
    Sheets("--Template--").Copy After:=Sheets(5)
    Sheets("--Template-- (2)").Select
    Sheets("--Template-- (2)").Name = TxtBox_Training.Value
    Range("B1") = TxtBox_Training.Value
    Range("B1").Replace What:=" ", Replacement:="_", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    ActiveSheet.ListObjects("").Name = Range("B1").Value
 
'Activate "Training List" sheet
With Worksheets("Training List").Activate
New_WS = TxtBox_Training.Value
 
    'Hide reference row
        Rows("11:11").Select
        Selection.EntireRow.Hidden = True
 
    'Replace tab address in formulas
        Range("G12:I12").Select
        Selection.Replace What:="--Template--", Replacement:=TxtBox_Training.Value, LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
 
    'Replace table's name in formulas
        Range("H12").Select
        Selection.Replace What:="Template", Replacement:=Worksheets(New_WS).Range("B1").Value, LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
 
    'Add hypertext link of new tab
        Range("B12").Select
        xxx = TxtBox_Training.Value
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
           xxx & "!Print_Area", TextToDisplay:=xxx
 
    'Sort training list A to Z
        ActiveWorkbook.Worksheets("Training List").AutoFilter.Sort.SortFields. _
            Clear
        ActiveWorkbook.Worksheets("Training List").AutoFilter.Sort.SortFields. _
            Add Key:=Range("B10"), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Training List").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
 
    'Protect sheet
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowSorting:=True, AllowFiltering:=True
 
End With
 
'Activate "Employees List" sheet
With Worksheets("Employees List").Activate
    ActiveSheet.Unprotect
 
    'Unhide hidden column
        Columns("G:K").Select
        Selection.EntireColumn.Hidden = False
 
    'Copy of reference column
        Columns("H:J").Select
        Selection.Copy
 
    'Insert at the end of table a new column
        Columns(nb_column1 + 1).Select
        Selection.Insert Shift:=xlToRight
        Application.CutCopyMode = False
 
    'Replace "--Template--" by the tab's name
        Columns(nb_column1 + 1).Select
        Selection.Replace What:="--Template--2", Replacement:=TxtBox_Training.Value, LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="--Template--", Replacement:=TxtBox_Training.Value, LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
 
        Columns(nb_column1 + 2).Select
        Selection.Replace What:="--Template--", Replacement:=TxtBox_Training.Value, LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="Year3", Replacement:="Year", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.EntireColumn.Hidden = True
 
        Columns(nb_column1 + 3).Select
        Selection.Replace What:="--Template--", Replacement:=TxtBox_Training.Value, LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.Replace What:="Hours4", Replacement:="Hours", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Selection.EntireColumn.Hidden = True
 
    'Hide reference column
        Columns("H:J").Select
        Selection.EntireColumn.Hidden = True
 
    'Protect sheet
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowSorting:=True, AllowFiltering:= _
            True
 
End With
 
'Activate "Training Hours" sheet
With Worksheets("Training Hours").Activate
 
    'Unhide hidden column
        Columns("E:G").Select
        Selection.EntireColumn.Hidden = False
 
    'Copy of reference column
        Columns("F:F").Select
        Selection.Copy
 
    'Insert at the end of table a new column
        Columns(nb_column2 + 1).Select
        Selection.Insert Shift:=xlToRight
        Application.CutCopyMode = False
 
    'Replace "--Template--" by the tab's name
        Selection.Replace What:="--Template--", Replacement:=TxtBox_Training.Value, LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
 
    'Hide reference column
        Columns("F:F").Select
        Selection.EntireColumn.Hidden = True
 
End With
 
'Close userform
    Unload Me
    Worksheets("Training List").Select
 
End Sub
Private Sub CdB_Cancel_Click()
    Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

Par la meme occasion au niveau des lignes 51 a 55 je souhaite changer le nom du tableau reference dans une formule.

Merci par avance pour votre collaboration.

Cordialement

Laurent

**Philippe PONS** · 04/04/2016, 12h54

Salut,

ok, mais quelle est ta question?
Doit on debuger ton code?
Dans ce cas, autant fournir un classeur exemple!
Cordialement,

**pimpom81** · 04/04/2016, 13h11

Mon probleme est que je ne sais pas comment comment coder le changement de nom du tableau reference, sachant qu'a chaque fois que je copie l'onglet "--Template--" le nom du tableau change (Ex: Template38)

Cordialement

**Philippe PONS** · 04/04/2016, 13h15

Ah! ok!
et ton tableau tu obtiens sa référence avec ListObjets("blablbla")?
Mais si il n'y a qu'un seul tableau sur la nouvelle feuille, tu peux y accéder
en passant un index numérique, comme;
ListObjects(0) ou ListObjects(1)
Tu n'as pas besoin de connaitre son nom!

**pimpom81** · 04/04/2016, 13h27

Merci Philippe.

ListObjects(1) marche.

Renommer un tableau reference en Vba

Macros et VBA Excel

Discussions similaires

Partager

Partager