AW: Blatt kopieren -Zellen mit mehr als 256 Zeichen
19.04.2010 13:57:09
fcs
Hallo Michael,
bei mehreren auf diese Weise zu kopierenende Blättern muss man zusätzlich auch die Quellarbeitsmappe deklarieren, damit Excel jeweils auf die korrekten Objekte zugreift.
Außerdem macht es einen Unterschied, ob für jedes Blatt eine neue Arbeitsmappe erstellt werden soll, oder beide Blätter in die gleiche Zielmappe kopiert werden sollen.
Es ist auch sinnvoller, mehrere Blätter in einer Schleife abzuarbeiten statt den Code zu duplizieren.
Gruß
Franz
Sub CoypTwoSheets_02()
'Zwei Blatter kopieren, jedes in eine neue Arbeitsmappe
Dim wksQuelle As Worksheet, wksZiel As Worksheet, BereichQuelle
Dim wbZiel As Workbook, wbQuelle As Workbook
Dim arrNamen, iI As Integer
arrNamen = Array("Tab1", "Tab2")
Set wbQuelle = ActiveWorkbook
For iI = LBound(arrNamen) To UBound(arrNamen)
Set wksQuelle = wbQuelle.Worksheets(arrNamen(iI))
Set BereichQuelle = wksQuelle.UsedRange
wksQuelle.Copy 'Blatt in neue Arbeitsmappe kopieren
Set wbZiel = ActiveWorkbook
Set wksZiel = ActiveSheet
BereichQuelle.Copy Destination:=wksZiel.Range(BereichQuelle.Address)
Next
End Sub
Sub CoypTwoSheets_01()
'Zwei Blatter in gleiche Zielmappe kopieren
Dim wksQuelle As Worksheet, wksZiel As Worksheet, BereichQuelle
Dim wbZiel As Workbook, wbQuelle As Workbook
Dim arrNamen, iI As Integer
arrNamen = Array("Tab1", "Tab2")
Set wbQuelle = ActiveWorkbook
For iI = LBound(arrNamen) To UBound(arrNamen)
Set wksQuelle = wbQuelle.Worksheets(arrNamen(iI))
Set BereichQuelle = wksQuelle.UsedRange
If wksQuelle.Name = arrNamen(LBound(arrNamen)) Then
wksQuelle.Copy 'Blatt in neue Arbeitsmappe kopieren
Set wbZiel = ActiveWorkbook
Else
'Blatt in Ziel-Arbeitsmappe kopieren
wksQuelle.Copy after:=wbZiel.Sheets(wbZiel.Sheets.Count)
End If
Set wksZiel = ActiveSheet
BereichQuelle.Copy Destination:=wksZiel.Range(BereichQuelle.Address)
Next
End Sub