[excel] reduire macro

Bonjour,
voila ma macro :

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 06/06/2008 par Portable 53
'
Dim Ligne As Byte, Col As Byte

Sheets("stat").Select
Col = 1
For Ligne = 9 To 12
V1 = Sheets("reponses").Cells(11, Col).Value
V2 = Sheets("stat").Cells(Ligne, 2).Value
Cells(Ligne, 2) = V1 + V2
Col = Col + 1
Next Ligne

Col = 1
For Ligne = 21 To 24
V1 = Sheets("reponses").Cells(12, Col).Value
V2 = Sheets("stat").Cells(Ligne, 2).Value
Cells(Ligne, 2) = V1 + V2
Col = Col + 1
Next Ligne

Col = 1
For Ligne = 31 To 34
V1 = Sheets("reponses").Cells(13, Col).Value
V2 = Sheets("stat").Cells(Ligne, 2).Value
Cells(Ligne, 2) = V1 + V2
Col = Col + 1
Next Ligne

Col = 1
For Ligne = 41 To 44
V1 = Sheets("reponses").Cells(14, Col).Value
V2 = Sheets("stat").Cells(Ligne, 2).Value
Cells(Ligne, 2) = V1 + V2
Col = Col + 1
Next Ligne

Col = 1
For Ligne = 51 To 54
V1 = Sheets("reponses").Cells(15, Col).Value
V2 = Sheets("stat").Cells(Ligne, 2).Value
Cells(Ligne, 2) = V1 + V2
Col = Col + 1
Next Ligne

Col = 1
For Ligne = 63 To 66
V1 = Sheets("reponses").Cells(16, Col).Value
V2 = Sheets("stat").Cells(Ligne, 2).Value
Cells(Ligne, 2) = V1 + V2
Col = Col + 1
Next Ligne

Col = 1
For Ligne = 73 To 76
V1 = Sheets("reponses").Cells(17, Col).Value
V2 = Sheets("stat").Cells(Ligne, 2).Value
Cells(Ligne, 2) = V1 + V2
Col = Col + 1
Next Ligne

V1 = Sheets("reponses").Cells(12, 6).Value
V2 = Sheets("stat").Cells(83, 2).Value
Cells(83, 2) = V1 + V2

V1 = Sheets("reponses").Cells(14, 6).Value
V2 = Sheets("stat").Cells(84, 2).Value
Cells(84, 2) = V1 + V2

Sheets("reponses").Select
'calcul le nbr de questions
Range("A1").Select
'calcul nombre de ligne
Selection.CurrentRegion.Select
NbLig = Selection.Rows.Count
'on met a faux la cellule A2
Range("A2").Select
ActiveCell.FormulaR1C1 = "false"
Range("B2").Select
ActiveCell.FormulaR1C1 = "false"
Range("C2").Select
ActiveCell.FormulaR1C1 = "false"
Range("D2").Select
ActiveCell.FormulaR1C1 = "false"
Range("F3").Select
ActiveCell.FormulaR1C1 = "false"
Range("F5").Select
ActiveCell.FormulaR1C1 = "false"

'rempli col b à d
Range("A2").Select
Selection.Copy
Selection.AutoFill Destination:=Range(Cells(2, 1), Cells(NbLig, 1))

Range("b2").Select
Selection.Copy
Selection.AutoFill Destination:=Range(Cells(2, 2), Cells(NbLig, 2))

Range("c2").Select
Selection.Copy
Selection.AutoFill Destination:=Range(Cells(2, 3), Cells(NbLig, 3))

Range("d2").Select
Selection.Copy
Selection.AutoFill Destination:=Range(Cells(2, 4), Cells(NbLig, 4))

'
End Sub
Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 06/06/2008 par Portable 53
'
Dim Ligne As Byte, Col As Byte

Sheets("stat").Select

For Ligne = 9 To 12
If Cells(Ligne, 2).Value <> 0 Then
Cells(Ligne, 2).Value = 0
End If
Next Ligne

For Ligne = 21 To 24
If Cells(Ligne, 2).Value <> 0 Then
Cells(Ligne, 2).Value = 0
End If
Next Ligne

For Ligne = 31 To 34
If Cells(Ligne, 2).Value <> 0 Then
Cells(Ligne, 2).Value = 0
End If
Next Ligne

For Ligne = 41 To 44
If Cells(Ligne, 2).Value <> 0 Then
Cells(Ligne, 2).Value = 0
End If
Next Ligne

For Ligne = 51 To 54
If Cells(Ligne, 2).Value <> 0 Then
Cells(Ligne, 2).Value = 0
End If
Next Ligne

For Ligne = 63 To 66
If Cells(Ligne, 2).Value <> 0 Then
Cells(Ligne, 2).Value = 0
End If
Next Ligne

For Ligne = 73 To 76
If Cells(Ligne, 2).Value <> 0 Then
Cells(Ligne, 2).Value = 0
End If
Next Ligne

For Ligne = 83 To 84
If Cells(Ligne, 2).Value <> 0 Then
Cells(Ligne, 2).Value = 0
End If
Next Ligne
'
End Sub

n'y aurait il pas un moyen de rétrécir un peut se code ?