Tabellenblatt austauschen

Hallo,
ich habe eine Dienstplantabelle erstellt mit unzähligen Bezügen zueinander. Es gibt u.a. 4 Tabellenblätter (Woche 1, Woche 2 ...). Nun habe ich viele Änderungen unter Woche 1 vorgenommen und möchte diese nun kopieren und damit die anderen Wochen ersetzen. Doch sobald ich die alte Tabelle lösche und die neue umbenenne verschwinden alle Bezüge zur alten Tabelle und es macht sehr sehr viel Arbeit diese Bezüge manuell wieder herzustellen. Nun meine Frage, kann man dieses automatische Anpassen der Bezüge durch Excel verhindern/kurzzeitig ausschalten, dann die Tabellenblätter austauschen und wieder einschalten? Z.B. durch VBA oder so?
Ich habe einige Forumseinträge dazu gefunden, aber keine passable Lösung. Vielleicht könnt ihr mir helfen?
Viele Grüße, Paul.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread