AW: Tabellenblatt austauschen
04.06.2015 17:01:59
Sepp
Hallo Paul,
du kannst mit folgendem Code die Formeln in eine Textdatei exportieren und nach dem Austausch der Tabellen wieder importieren. Teste es aber bitte zuerst an einer Kopie deiner Datei!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub ExportCellFormulas()
Dim objSH As Worksheet
Dim rng As Range
Dim strTmp As String, strFile As String
Dim FF As Integer
strFile = ThisWorkbook.FullName & "_formulas.txt"
On Error Resume Next
FF = FreeFile
Open strFile For Output As #FF
For Each objSH In ThisWorkbook.Worksheets
For Each rng In objSH.UsedRange.SpecialCells(xlCellTypeFormulas)
strTmp = rng.Parent.Name & ";" & rng.Address(0, 0) & ";" & IIf(rng.HasArray, "#Array" & rng.FormulaArray, rng.Formula)
Print #FF, strTmp
Next
Next
Close #FF
On Error GoTo 0
End Sub
Sub ImportCellFormulas()
Dim strTmp As String, strFile As String
Dim strSheet As String, strRange As String, strFormula As String
Dim FF As Integer
strFile = ThisWorkbook.FullName & "_formulas.txt"
If Dir(strFile, vbNormal) <> "" Then
FF = FreeFile
Application.Calculation = xlCalculationManual
Open strFile For Input As #FF
Do While Not EOF(FF)
Line Input #FF, strTmp
strSheet = Split(strTmp, ";")(0)
strRange = Split(strTmp, ";")(1)
strFormula = Split(strTmp, ";")(2)
If Left(strFormula, 6) = "#Array" Then
Sheets(strSheet).Range(strRange).FormulaArray = Mid(strFormula, 7)
Else
Sheets(strSheet).Range(strRange).Formula = strFormula
End If
Loop
Close #FF
Else
MsgBox "Keine Datei gefunden!", vbInformation
End If
Application.Calculation = xlCalculationAutomatic
End Sub
Gruß Sepp