Option Explicit
Sub DoIt()
Dim Sh As Worksheet
Dim rngB As Range, rngC As Range, rngF As Range
Dim arrC() As Variant, strf As String, y As Long, c As Range
ActiveSheet.Copy
Set Sh = ActiveSheet
With Sh.UsedRange
On Error Resume Next
Set rngB = .SpecialCells(4)
Set rngF = .SpecialCells(-4123)
Set rngC = .SpecialCells(2)
On Error GoTo 0
If Not rngB Is Nothing Then SubsIt rngB.Address, "B"
If Not rngF Is Nothing Then SubsIt rngF.Address, "F"
If Not rngC Is Nothing Then SubsIt rngC.Address, "C"
End With
strf = Replace(ThisWorkbook.FullName, "xlsm", "txt")
Open strf For Output As #1
With Sh.UsedRange
For y = 1 To .Columns.Count
For Each c In .Columns(y).Cells
Print #1, c.Value
Next c
Next y
End With
Close #1
ActiveWorkbook.Close False
End Sub
Private Sub SubsIt(strAddr As String, ToDo As String)
Dim rnga As Range, rngr As Range, c As Range, strf As String
With Range(strAddr)
For Each rnga In .Areas
For Each rngr In rnga.Rows
For Each c In rngr.Cells
Select Case ToDo
Case "B"
c.NumberFormat = "General"
c.Value = c.Address(0, 0) & " ="
Case "F"
strf = c.FormulaLocal
c.Clear
c.Value = c.Address(0, 0) & " = " & strf
Case "C"
c.NumberFormat = "General"
c.Value = c.Address(0, 0) & " = " & c.Value
End Select
Next c
Next rngr
Next rnga
End With
End Sub