Anzeige
Archiv - Navigation
1660to1664
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Backup der Werte

Backup der Werte
30.11.2018 17:57:27
Peerli
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.

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

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

Betreff
Datum
Anwender
Anzeige
AW: Backup der Werte
02.12.2018 09:04:02
fcs
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
Anzeige
AW: Backup der Werte
02.12.2018 09:55:46
Peerli
Hallo Franz.
Vielen vielen dank für deine Hilfe. Es funktioniert.
LG aus Bayern
Peer

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige