Problème de macro VBA

Sub EFFACE()
  If ActiveSheet.Name <> "Dépenses mensuelles" Then Exit Sub
  Application.ScreenUpdating = 0
  Range("B2:C7, D5:D6, F3:F7, I2:I6, A10:B46, C10:H27, C30:H46, I11, I13, I15, " _
    & "I17, I19, I21:I24, I27:I29, I32:I33, I35:I37, I40:I46").ClearContents
  [B29] = "BUREAU"
End Sub

Private Sub CpyTotaux(k As Byte)
  If ActiveSheet.Name <> "Dépenses mensuelles" Then Exit Sub
  Application.ScreenUpdating = 0
  With Worksheets("vierge")
    [D2:D4].Copy: .Cells(5, k).PasteSpecial -4163   'Traitement, Laurence, Sécu AJ / MGEN
    .Cells(8, k) = [D7]                             'Sécu. Remb
    .Cells(9, k) = [G6]                             'Remb. Divers
    [G3:G4].Copy: .Cells(10, k).PasteSpecial -4163  'Loyer bijouterie, Dons Vir.
    .Cells(14, k) = [A47]                           'Alimentation
    .Cells(15, k) = [C28]                           'Prod Entretien
    .Cells(16, k) = [D28]                           'Automobile
    [D47].Resize(, 4).Copy                          'Impôts, Cadeaux, Habits, Santé
    .Cells(17, k).PasteSpecial -4163, , , True
    .Cells(21, k) = [J11]                           'EDF
    .Cells(22, k) = [I25]                           'Téléphone
    .Cells(23, k) = [J15]                           'Eau
    .Cells(24, k) = [J19]                           'Fioul
    .Cells(25, k) = [J17]                           'BOIS
    .Cells(26, k) = [J13]                           'Gaz
    .Cells(27, k) = [J33]                           'Prêt Immob.
    .Cells(28, k) = [I30]                           'Assurances
    [E28].Resize(, 3).Copy                          'Bricolage, Jardin, Loisirs + Sports
    .Cells(29, k).PasteSpecial -4163, , , True
    .Cells(32, k) = [H47]                           'Divers
    .Cells(33, k) = [B47]                           'Bureau
    .Cells(34, k) = [C47]                           'Equipement
    .Cells(35, k) = [H28]                           'Vacances
    .Cells(36, k) = [I47]                           'Copropriété
    .Cells(37, k) = [I38]                           'Frais Bancaires
    .Select: [A1].Select: Application.CutCopyMode = 0
    Worksheets("Dépenses mensuelles").Select
  End With
End Sub

Sub JANV()
  CpyTotaux 3
End Sub

Sub FEVR()
  CpyTotaux 4
End Sub

Sub MARS()
  CpyTotaux 5
End Sub

Sub AVRIL()
  CpyTotaux 6
End Sub

Sub MAI()
  CpyTotaux 7
End Sub

Sub JUIN()
  CpyTotaux 8
End Sub

Sub JUILLET()
  CpyTotaux 9
End Sub

Sub AOUT()
  CpyTotaux 10
End Sub

Sub SEPTEMBRE()
  CpyTotaux 11
End Sub

Sub OCTOBRE()
  CpyTotaux 12
End Sub

Sub NOVEMBRE()
  CpyTotaux 13
End Sub

Sub DECEMBRE()
  CpyTotaux 14
End Sub