Microsoft Excel

Herbers Excel/VBA-Archiv

Backup der Werte


Betrifft: Backup der Werte
von: Peerli
Geschrieben am: 30.11.2018 17:57:27

Hallo liebe Excel-Fans

Kann man diesen Code auch so anpassen, dass er alle vorhandenen Blätter in diese Datei speichert, egal wie viel Blätter das Workbook hat? Und es sollen alle Zellen gespeichert werden, die nicht gesperrt sind.
Hintergrund: Ich möchte die Eingabewerte als Backup speichern und sie nach dem Anpassen des _ Layout des Workbooks die Werte wieder in die selben Zellen zurückschreiben.

Betrifft: AW: Zelleninhalte Export / Import
von: fcs
Geschrieben am: 06.08.2012 09:41:48

Hallo Jürgen,

da du Inhalte aus mehreren Blättern exportieren/importieren möchtest muss du in der Textdatei    _
_
_
auch die Information speichern, aus welchelchem tabellenblatt die Inhalte stammen.

Ich hab Sepps Makros mal in diese Richtung angepasst.

Gruß
Franz

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
' Original-Code von Josef Ehrensberger
Option Explicit


Sub exportValuesToText()
  Dim vntFile As Variant
  Dim wks As Worksheet, strRange As String
  Dim rng As Range, rngC As Range, lngZeile As Long, lngSpalte As Long
  Dim ff As Integer
  
  On Error GoTo Fehler
  
    vntFile = Application.GetSaveAsFilename("Werte.txt", "Text Files (*.txt), *.txt")
    If vntFile <> False Then
      ff = FreeFile
      Open vntFile For Output As #ff
      
      Set wks = Worksheets("Einstellungen")
      strRange = "C2:C13,B16,B19,B20,B21"
      Set rngC = wks.Range(strRange)
      For Each rng In rngC.Cells
        Print #ff, wks.Name & ";" & rng.Address(0, 0) & ";" & rng.Formula
      Next
      
      Set wks = Worksheets("Übersicht")
      For lngSpalte = 3 To 25 Step 2 'SPalten C, E, bis Y
        For lngZeile = 6 To 36
          Set rng = wks.Cells(lngZeile, lngSpalte)
          Print #ff, wks.Name & ";" & rng.Address(0, 0) & ";" & rng.Formula
        Next
      Next lngSpalte
      
      Close #ff
    End If
Fehler:
  With Err
    Select Case .Number
      Case 0 'alles OK
      Case Else
        MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
        Close
    End Select
  End With
  Set rng = Nothing
  Set rngC = Nothing
  Set wks = Nothing
End Sub


Sub importValuesFromText()
  Dim strFile As String, strTmp As String
  Dim ff As Integer
  On Error GoTo Fehler
  strFile = Application.GetOpenFilename("Text Dateien (*.txt),*.txt")
  
  If strFile <> CStr(False) Then
    ff = FreeFile
    Open strFile For Input As #ff
    Do While Not EOF(ff)
      Line Input #ff, strTmp
      With Worksheets(Split(strTmp, ";")(0)).Range(Split(strTmp, ";")(1))
        .Formula = Split(strTmp, ";")(2)
      End With
    Loop
    Close #ff
  End If
Fehler:
  With Err
    Select Case .Number
      Case 0 'alles OK
      Case Else
        MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
        Close
    End Select
  End With
End Sub
LG
Peer

  

Betrifft: AW: Backup der Werte
von: fcs
Geschrieben am: 02.12.2018 09:04:02

Hallo Peer,

hier das angepasste Export-Makro:

Sub exportValuesToText()
  Dim vntFile As Variant
  Dim wks As Worksheet
  Dim rng As Range
  Dim ff As Integer
  
  On Error GoTo Fehler
  
    vntFile = Application.GetSaveAsFilename("Werte.txt", "Text Files (*.txt), *.txt")
    If vntFile <> False Then
      ff = FreeFile
      Open vntFile For Output As #ff
      
      For Each wks In ActiveWorkbook.Worksheets
      
        For Each rng In wks.UsedRange.Cells
          If rng.Locked = False And rng.Formula <> "" Then
              Print #ff, wks.Name & ";" & rng.Address(0, 0) & ";" & rng.Formula
          End If
        Next
      
      Next
      Close #ff
    End If
Fehler:
  With Err
    Select Case .Number
      Case 0 'alles OK
      Case Else
        MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
        Close
    End Select
  End With
  Set rng = Nothing
  Set wks = Nothing
End Sub


LG from China

Franz


  

Betrifft: AW: Backup der Werte
von: Peerli
Geschrieben am: 02.12.2018 09:55:46

Hallo Franz.

Vielen vielen dank für deine Hilfe. Es funktioniert.

LG aus Bayern
Peer