我建议使用Find函数，以便Excel查找公式，而不是循环遍历所有单元格（这很耗时）：

Sub replaceFunction()
    Const FunctionName = "GetCTData" 
    With ActiveCell.Cells                  ' Consider to specify the worksheet.
        Dim hit As Range
        Set hit = .Find(What:=FunctionName , _
                       LookIn:=xlFormulas2, _
                       LookAt:=xlPart)
        If Not hit Is Nothing Then         ' At least one cell found with formula
            Do
                hit.Value = hit.Value      ' Replace value
                Set hit = .FindNext(hit)   ' Search next cell with formula
            Loop While Not hit Is Nothing  ' ...until no more found.
        End If
    End With
End Sub

它看起来可能有点奇怪，但是hit.Value = hit.Value用它的实际值替换了公式。

循环查找“GetCtData”听起来不可避免，但您应该避免剪贴板
例如，使用以下代码代替两行“...Copy”和“...PasteSpecial用途：

Cells(r, c).Value = Cell(r, c).Value

...用单元格自己的值覆盖单元格
您还可以删除在变量'cellContent'中存储公式的行，这样底部代码块就可以重写如下：

For c = activeCellColumn To endCol
    For r = activeCellRow To endRow
     
        If InStr(1, Cells(r, c).Formula, "GetCtData") Then
           Cells(r, c).Value = Cells(r, c).Value
        End If

    Next r
Next c

绕过剪贴板将保存相当多的时间，也是更少的bug（值得一读的避免剪贴板作为一个一般规则）

公式到值

• • 主要**

Sub FormulasToValues()

    Const FORMULA_IDENTIFIER As String = "GetCtData"

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rg As Range: Set rg = ws.UsedRange
    
    Dim rCount As Long: rCount = rg.Rows.Count
    Dim cCount As Long: cCount = rg.Columns.Count
    
    Dim rOffset As Long: rOffset = rg.Row - 1
    Dim cOffset As Long: cOffset = rg.Column - 1
    
    Dim Data(): Data = rg.Formula
    
    Dim drg As Range, c As Long, r As Long, fr As Long, lr As Long, cc As String
    
    For c = 1 To cCount
        cc = GetColumnString(c + cOffset)
        For r = 1 To rCount
            If InStr(Data(r, c), FORMULA_IDENTIFIER) > 0 Then
                If fr = 0 Then fr = r + rOffset
                lr = r + rOffset
            Else
                If fr > 0 Then CombineAndReset drg, fr, ws, lr, cc
            End If
        Next r
        If fr > 0 Then CombineAndReset drg, fr, ws, lr, cc
    Next c
                
    If drg Is Nothing Then
        MsgBox "No formulas containing """ & FORMULA_IDENTIFIER _
            & """ found. No action taken.", vbExclamation
        Exit Sub
    End If
    
    PasteAreasValues drg

    With ws.Parent
        If .Name = "VALUE.xlsx" Then .Save Else .SaveAs Filename:="VALUE"
    End With
   
    MsgBox "Formulas containing """ & FORMULA_IDENTIFIER _
        & """ replaced with values.", vbInformation

End Sub

• • 帮助**

Function GetColumnString(ByVal ColumnNumber As Long) As String
    Dim Remainder As Long
    Do
        Remainder = (ColumnNumber - 1) Mod 26
        GetColumnString = Chr(Remainder + 65) & GetColumnString
        ColumnNumber = Int((ColumnNumber - Remainder) \ 26)
    Loop Until ColumnNumber = 0
End Function

Sub CombineAndReset( _
        ByRef urg As Range, _
        ByRef fr As Long, _
        ByVal ws As Worksheet, _
        ByVal lr As Long, _
        ByVal cc As String)
    CombineRanges urg, ws.Range(cc & fr & ":" & cc & lr)
    fr = 0
End Sub

Sub CombineRanges(ByRef urg As Range, ByVal arg As Range)
    If urg Is Nothing Then Set urg = arg Else Set urg = Union(urg, arg)
End Sub

Sub PasteAreasValues(ByVal rg As Range)
    Dim arg As Range
    For Each arg In rg.Areas: arg.Value = arg.Value: Next arg
End Sub