AW: export von zellwerten
05.09.2009 19:50:19
zellwerten
Hallo Markus,
hier eine Möglichkeit.
Es wird eine Arbeitsmappe erstellt, in der die Blätter mit den Daten der ungeschützen Zellen eingetragen sind.
Gruß
Franz
Sub ExportUngeschuetzt()
Dim WbQuelle As Workbook, wbZiel As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet, Spalte As Long
Dim Zelle As Range
Application.ScreenUpdating = False
Set WbQuelle = ActiveWorkbook
For Each wksQuelle In WbQuelle.Worksheets
If wksQuelle.Index = 1 Then
Workbooks.Add Template:=xlWBATWorksheet
Set wbZiel = ActiveWorkbook
Else
wbZiel.Worksheets.Add after:=wksZiel
End If
Set wksZiel = ActiveSheet
wksZiel.Name = wksQuelle.Name
For Spalte = wksQuelle.UsedRange.Column To wksQuelle.UsedRange.Columns.Count
wksZiel.Columns(Spalte).ColumnWidth = wksQuelle.Columns(Spalte).ColumnWidth
Next
For Each Zelle In wksQuelle.UsedRange
If Zelle.Locked = False Then
If Zelle.HasFormula Then
wksZiel.Range(Zelle.Address) = "'" & Zelle.Formula
Else
Zelle.Copy Destination:=wksZiel.Range(Zelle.Address)
End If
End If
Next
Next
wbZiel.SaveAs Filename:=WbQuelle.Path & Application.PathSeparator _
& "Data_" & WbQuelle.Name, FileFormat:=xlWorkbookNormal
wbZiel.Close
Application.ScreenUpdating = False
End Sub
Sub ImportUngeschuetzt()
Dim WbQuelle As Workbook, wbZiel As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet, Spalte As Long
Dim Zelle As Range
Application.ScreenUpdating = False
Set wbZiel = ActiveWorkbook
Set WbQuelle = Workbooks.Open(Filename:=wbZiel.Path & Application.PathSeparator _
& "Data_" & wbZiel.Name, ReadOnly:=True)
For Each wksZiel In wbZiel.Worksheets
Set wksQuelle = WbQuelle.Worksheets(wksZiel.Name)
For Each Zelle In wksZiel.UsedRange
If Zelle.Locked = False Then
If Zelle.HasFormula Then
Zelle.Formula = wksQuelle.Range(Zelle.Address).Value
Else
Zelle.Value = wksQuelle.Range(Zelle.Address).Value
End If
End If
Next
Next
WbQuelle.Close Savechanges:=False
Application.ScreenUpdating = False
End Sub