提取EXCEL工作表中公式的单元格的代码

Sub 提取带公式的单元格()
    Dim FormulaCells As Range, Cell As Range
    Dim FormulaSheet As Worksheet
    Dim Row As Integer
    
    '创建Range对象
    On Error Resume Next
    Set FormulaCells = Range("A1").SpecialCells(xlCellTypeFormulas, 23)
    
    '没有找到公式
    If FormulaCells Is Nothing Then
        MsgBox "当前工作表中没有公式！"
        Exit Sub
    End If
    
    '增加一个新工作表
    Application.ScreenUpdating = False
    Set FormulaSheet = ActiveWorkbook.Worksheets.Add
    FormulaSheet.Name = "“" & FormulaCells.Parent.Name & "”表中的公式"
    
    '列标题
    With FormulaSheet
        Range("A1") = "公式所在单元格"
        Range("B1") = "公式"
        Range("C1") = "值"
        Range("A1:C1").Font.Bold = True
    End With
    
    '读取公式，同时在状态栏中显示进度。
    Row = 2
    For Each Cell In FormulaCells
        Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
        With FormulaSheet
            Cells(Row, 1) = Cell.Address _
                (RowAbsolute:=False, ColumnAbsolute:=False)
            Cells(Row, 2) = " " & Cell.Formula
            Cells(Row, 3) = Cell.Value
            Row = Row + 1
        End With
    Next Cell
    
    '调整列宽
    FormulaSheet.Columns("A:C").AutoFit
    Application.StatusBar = False

End Sub

---------------------------------------------------

Sub 提取带公式的单元格()
    Dim FormulaCells As Range, Cell As Range
    Dim FormulaSheet As Worksheet
    Dim Row As Integer
    
    '创建Range对象
    On Error Resume Next
    Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)
    
    '没有找到公式
    If FormulaCells Is Nothing Then
        MsgBox "当前工作表中没有公式！"
        Exit Sub
    End If
    
    '增加一个新工作表
    Application.ScreenUpdating = False
    Set FormulaSheet = ActiveWorkbook.Worksheets.Add
    FormulaSheet.Name = "“" & FormulaCells.Parent.Name & "”表中的公式"
    
    '列标题
    With FormulaSheet
        Range("A1") = "公式所在单元格"
        Range("B1") = "公式"
        Range("C1") = "值"
        Range("A1:C1").Font.Bold = True
    End With
    
    '读取公式，同时在状态栏中显示进度。
    Row = 2
    For Each Cell In FormulaCells
        Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
        With FormulaSheet
            Cells(Row, 1) = Cell.Address _
                (RowAbsolute:=False, ColumnAbsolute:=False)
            Cells(Row, 2) = " " & Cell.Formula
            Cells(Row, 3) = Cell.Value
            Row = Row + 1
        End With
    Next Cell
    
    '调整列宽
    FormulaSheet.Columns("A:C").AutoFit
    Application.StatusBar = False
End Sub