Macro excel qui marche plus

Bonjour,

J'avais une super macroqui marchait super bien... c'était le bon temps... puis on a changer de version on est passé de 2003 à 2007 et on a même changer klk liens du serveurs ...

Et ma macro dans tout ca.... :$

perdue lessivée et carrement bancale....

Voilà le but de ma macro :
dans une suite de données àdditionner entre elles toutes les céllules de la colonne B ayant les même données à la colonne A et les même données à la colonne C.

Voilà ma macro :
Sub Total()

Application.ScreenUpdating = False

On Error Resume Next

'trouver le dernier enregistrement complet

Dim Ligne As Long
Dim Ligne2 As Long

Ligne = (Range("A1").End(xlDown).Row + 1)

'remplacement des #N/A

Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

o = "A" & Ligne
p = "C" & 65536
q = o & ":" & p
Range(q).Select
Selection.ClearContents

'suppression des blancs
Range("E1").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(RC[-2]:R[" & Ligne - 1 & "]C[-2],"""")"
b = ActiveCell.Value

For h = 2 To Ligne - 1 - b
Cells(h, 3).Select
If ActiveCell.Value = "" Then
Rows(h).Delete
h = h - 1
End If
Next h

Range("E1").Select
Selection.Clear

'création des sous-totaux

Range("D2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-1])"
Selection.AutoFill Destination:=Range("D2:D" & Ligne - 1), Type:=xlFillDefault

Range("A1:D" & Ligne - 1).Select

Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(2), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=False

Columns(4).ClearContents

'ajout des infos opérateur et matière

Ligne2 = (Range("B1").End(xlDown).Row + 1)

For i = 2 To Ligne2
Cells(i + 1, 1).Select
If ActiveCell.Value <> "" Then
Cells(i, 1).Value = Cells(i + 1, 1).Value
Cells(i, 3).Value = Cells(i + 1, 3).Value
End If
Next i

'copie sur une nouvelle feuille
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("A1").Select
Selection.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add
ActiveSheet.Name = "Total"
Sheets("Total").Move after:=Sheets("Excel")
Sheets("Excel").Select
Range("A3:C" & Ligne2 - 1).Select
Selection.SpecialCells(xlCellTypeVisible).Copy
Sheets("Total").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Excel").Select
Range("A1:C1").Select
Selection.Copy
Sheets("Total").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select

Sheets("Excel").Select
ActiveSheet.Shapes("Button 1").Select
Selection.Copy
Sheets("Total").Select
Range("F1").Select
ActiveSheet.Paste

Application.DisplayAlerts = False
Sheets("Excel").Delete
Application.DisplayAlerts = True
Sheets("Total").Select
ActiveSheet.Name = "Excel"

Range("A1").Select


Application.ScreenUpdating = True

End Sub



Voila mon fichier :
http://www.cijoint.fr/cjlink.php?file=cj201012/cijHksrQYK.xls

S'il vous plai aidez moi...

Merci d'avance