Macro en remplacement d'une liste de choix

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Sh.Name = "Budget 09" Or Target.Interior.ColorIndex > 0 _
  Or Intersect(Target, Sh.Columns(2)) Is Nothing Then Exit Sub
Cancel = True
UserForm1.Show
End Sub

Private Sub ComboBox1_Change()
Dim lig As Variant
ActiveCell = ComboBox1
lig = Application.Match(ComboBox1, [Categories], 0)
If IsNumeric(lig) Then
ActiveCell.Offset(, 1) = [Categories].Offset(, 1)(lig)
Else
ActiveCell.Offset(, 1) = ""
End If
End Sub

Private Sub UserForm_Initialize()
ComboBox1.SetFocus
SendKeys "%{DOWN}"
End Sub

Private Sub WorkBook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
If Sh.Name = "Budget 09" Or Intersect(Source, Sh.Columns(2)) Is Nothing Or Source.Count > 1 Then Exit Sub
If Source.Interior.ColorIndex > 0 Then Exit Sub
Dim lig As Variant
lig = Application.Match(Source, [Categories], 0)
If IsNumeric(lig) Then
Source.Offset(, 1) = [Categories].Offset(, 1)(lig)
Else
Source.Offset(, 1) = ""
End If
End Sub