Makrofehler seit Umstellung auf Office 10

Hallo,
dieses Makro lief unter Office 2003 einwandfrei bis mein Chef auf
Office 10 umgestellt hat.
Ich würde mich freuen, wenn jemand helfen kann damit dieses Makro
wieder funktioniert. Die Stelle wo der Fehler auftritt ist gekennzeichnet.
Vielen Dank im voraus
Peter
Option Explicit

Sub TabellenAbgleichen_Test1()
Const SpalteAb As Long = 12
Const SpalteBis As Long = 26
Const SpalteVergleich As Long = 3
Const ZeileAb As Long = 2
Application.ScreenUpdating = False
Dim ShZ As Worksheet, ShQ As Worksheet, ShA As Worksheet
Set ShQ = Worksheets("Vor")
Set ShZ = Worksheets("Akt")
Set ShA = Worksheets("Alt")
Dim ZeileBis As Long
Dim r As Range
Dim ZeileRein As Long
Dim ZeileLetzteAlt
Dim ZeileLetzteZu
With ShA 'freie Zeile in  Worksheets("Alt") feststellen
ZeileLetzteAlt = .Cells(.Rows.Count, SpalteVergleich).End(xlUp).Row
End With
With ShQ 'Worksheets("BestandVortag")
'letzte Zeile feststellen
ZeileBis = .Cells(.Rows.Count, SpalteVergleich).End(xlUp).Row
For Each r In .Range(.Cells(ZeileAb, SpalteVergleich), .Cells(ZeileBis, SpalteVergleich))
If WorksheetFunction.CountIf(ShZ.Cells(1, SpalteVergleich).EntireColumn, r.Value) = 1  _
Then
.Range(.Cells(r.Row, SpalteAb), .Cells(r.Row, SpalteBis)).Copy
'>>>Fehler >>>>>   ShZ.Cells(WorksheetFunction.Match(r.Value, ShZ.Cells(1, SpalteVergleich). _
EntireColumn, False), SpalteAb).PasteSpecial
Application.CutCopyMode = False
Else
ZeileLetzteAlt = ZeileLetzteAlt + 1
.Cells(r.Row, SpalteAb).EntireRow.Copy
ShA.Cells(ZeileLetzteAlt, 1).PasteSpecial
Application.CutCopyMode = False
End If
.Cells(r.Row, 1).EntireRow.ClearContents
Next r
End With
End Sub