suchen und ersetzen

ich möchte Spaltenüberschriften ändern und
habe dazu folgende Prozedur:

Sub SuchenUndErsetzen()
Dim SQuelle As Variant, SZiel As Variant, i As Integer, c As Range, SAdd As String
Dim z As Integer, arr() As Integer

Workbooks(2).Activate

SQuelle = Array("C_NUMBER", "A_NAME1", "A_NAME2", "C_AREA_NETTO", "GFB_A_B_C", _
       "A_NAME3", "A_USE_KEY", "A_HEIGHT", "A_FENSTER", "A_TUERANZ", "A_BODENBEL")
SZiel = Array("SAP-Nummer |", "Raumnummer vor Ort |", "Raumbezeichnung vor Ort |", _
            "m^2 nach DIN |", "Bereich nach DIN |", "Raumnummer nach Vorlageplan |", _
            "Fläche nach DIN |", "Raumhöhe von |", "Fensterfläche |", "Türanzahl |", _
            "Bodenbelag |")

For i = LBound(SQuelle) To UBound(SQuelle)
With Cells

Set c = .Replace(SQuelle(i), SZiel(i), LookIn:=xlValues, lookat:=xlWhole)
'Set c = .Find(SB(i), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
SAdd = c.Address
Do
On Error Resume Next
z = z + 1
ReDim Preserve arr(z)
arr(z) = c.Column
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> SAdd
End If
End With
Next

Set c = Nothing
End Sub