AW: Nachfrage
07.04.2012 00:29:15
fcs
Hallo Steve,
hier mein Lösungsvorschlag für ein entsprechendes Makro erstellt unter Excel 2010
Gruß
Franz
Sub Export_Data_and_Formats()
'Formate und Daten aus Tabellenblättern in neue Datei exportieren
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim Zelle As Range
Set wbQuelle = ActiveWorkbook
For Each wksQuelle In wbQuelle.Worksheets
If wbZiel Is Nothing Then
'neue Arbeitsmappe mit einem Blatt anlegen
Set wbZiel = Application.Workbooks.Add(Template:=xlWBATWorksheet)
Else
'weiteres Blatt in neuer Arbeitsmappe anfügen
With wbZiel
.Worksheets.Add After:=.Sheets(.Sheets.Count)
End With
End If
Set wksZiel = wbZiel.Sheets(wbZiel.Sheets.Count)
'Zieltabelle umbenennen
wksZiel.Name = wksQuelle.Name
Select Case wksQuelle.Index
Case 1
'Bereich A3:O... kopieren
With wksQuelle
'Spaltenbreiten übertragen
For Each Zelle In .Range("A3:O3")
wksZiel.Columns(Zelle.Column).ColumnWidth = .Columns(Zelle.Column).ColumnWidth
Next
'Letzte Zeile mit Daten ermitteln
With .UsedRange
Set Zelle = .Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, lookat:=xlWhole, _
_
searchdirection:=xlPrevious)
End With
'Zellen A3:O... kopieren
.Range(.Cells(3, 1), .Cells(Zelle.Row, 15)).Copy
End With
'Formate und Werte ab Zelle A3 einfügen
wksZiel.Cells(3, 1).PasteSpecial Paste:=xlPasteFormats
wksZiel.Cells(3, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Case 2
'Aus allen Zelle die farbig sind den Wert in die entspechende Zelle im Zielblatt _
eintragen
For Each Zelle In wksQuelle.UsedRange
If Zelle.Interior.ColorIndex xlColorIndexNone Then
wksZiel.Cells(Zelle.Row, Zelle.Column).Value = Zelle.Value
End If
Next
Case Else
'do nothing
End Select
Next
End Sub