Copy über mehrere Sheets

Hallo Zusammen,
ich möchte folgendes realisieren:
In einem workbook mit vielen sheets möchte ich für mehrere sheets jeweils die x. Zeile n-mal in den Bereich ab Zeile y kopieren.
Für ein sheet würde das ungefähr so aussehen:
Call sheets(1).rows(QUELL_ZEILE).Copy(Range(sheets(1).rows(BEREICH_ZEILEN_AB), sheets(1).rows(BEREICH_ZEILEN_BIS))
Das kann ich jetzt natürlich in eine for next-Schleife packen und für jedes gewünschte sheet ausführen. Will ich aber nicht :-)
Da ich ja in allen sheets die gleiche Zeile in den gleichen Bereich kopiere, müßte es doch auch für alle gleichzeitig gehen, oder? "Von Hand" geht das doch auch. Aber in VBA bekomme ich es auch nur so hin, wie das aufgezeichnete Makro, d.h. alles nur mit Select. Also Sheets(Array("Sheet4", "Sheet5")).Select, dann rows(QUELL_ZEILE).select, Selection.copy usw.
Geht das nicht anders?!
Gruß,
Stephan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Stephan,
beim Gruppieren von Blättern kommt man bei der nachfolgenden Kopier-Aktion nicht um die Select-Anweisungen herum.
Warum möchtest du nicht, dass die Blätter in einer Schleife abgearbeitet werden?
Hier mal die erforderlichen Makros in etwas allgemeinerer Form.
Gruß
Franz


Sub aatest()
'Kopieren Blattweise
'testdaten
QUELL_ZEILE = 10
BEREICH_ZEILEN_AB = 20
BEREICH_ZEILEN_BIS = 30
Application.ScreenUpdating = False
For intI = 1 To Worksheets.Count
With Worksheets(intI)
Select Case Worksheets(intI).Name
Case "Tabelle1" 'Namen der Ausnahmeblätter
Case Else
.Rows(QUELL_ZEILE).Copy .Range(.Rows(BEREICH_ZEILEN_AB), .Rows(BEREICH_ZEILEN_BIS))
End Select
End With
Next
Application.ScreenUpdating = True
End Sub
Sub abtest()
'Kopieren bei gruppierten Blättern
'Testdaten
QUELL_ZEILE = 10
BEREICH_ZEILEN_AB = 20
BEREICH_ZEILEN_BIS = 30
Dim arrBlatt() As String, objSheet, objAktiv
'Aktuelle Selektion merken
Set objSheet = ActiveSheet
Set objAktiv = Selection
'Tabellen-Blattnamen in eine Array einlesen
For intK = 1 To Worksheets.Count
Select Case Worksheets(intK).Name
Case "Tabelle1" 'Namen der Ausnahmeblätter
Case Else
intI = intI + 1
ReDim Preserve arrBlatt(1 To intI)
arrBlatt(intI) = Worksheets(intK).Name
End Select
Next
'Tabellen gruppieren
Worksheets(arrBlatt).Select
'Zeile kopieren
ActiveSheet.Rows(QUELL_ZEILE).Copy
'Zielzeilen markieren
Range(Rows(BEREICH_ZEILEN_AB), Rows(BEREICH_ZEILEN_BIS)).Select
'Einfügen
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Select
'Gruppierung wieder aufheben
objSheet.Select
'Letzte Selektion wieder herstellen
objAktiv.Select
End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread