einfach und geschmacklos

langsam und gemütlich zum Mitdenken

von Hinten durch die Brust ins Auge

So

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
   
'Ich übernehme keinerlei Gewähr für die Aktualität, Richtigkeit und Vollständigkeit,
'denn was interessiert mich der Schmäh', den ich vor 10 min. geschrieben habe.
'Hauptsache er war gut!

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