Kopieren auf 4 Tabellen ausweiten -

Sub Auswahl_kopieren() Dim intZeile As Integer Selection.Copy intZeile = Sheets("Gesamt").UsedRange.Rows.Count + 1 Sheets("Gesamt").Activate Cells(intZeile, 1).Select ActiveSheet.Paste Sheets("Tabelle1").Activate Application.CutCopyMode = False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Matthias,
ich habe mir soeben Deine Mustermappe herunter geladen. Der Code macht leider das Gegenteil von dem, was ich gerne erreichen würde. Ich würde gerne erreichen, dass in das Tabellenblatt "Gesamt" der Inhalt von Tabelle1,2,3 und/oder 4 kopiert wird. Ich habe dabei auch schon selbst versucht, Problem im untenstehenden Code ist nur, dass immer alle 4 Tabellenblätter vorhanden sein müßten, das ist aber nicht der Fall. Wie könnte der Code angepaßt werden, damit er auch läuft, wenn nur Tabelle1 vorhanden ist, aber auch ggfs. eben bis Tabelle4 alle Blätter vorhanden sind, aus denen kopiert werden soll. Weiteres Problem habe ich, dass von jedem Tabellenblatt die Überschriften aus Zeile1 mitkopiert werden. Müßte ich evtl. auch beachten, dass noch weitere Tabellenblätter in der Mappe vorhanden sind, aus denen nicht kopiert werden soll? -Grunddaten-, Altdaten; Ich hatte da auch schon etwas mit Case.... versucht, das ignoriert aber wohl der Code. Wäre Dir sehr dankbar für eine erneute Rückmeldung.
Herzliche Grüße
Wolfgang


Sub CopyGesamt()
Dim wks As Worksheet, lngRow As Long
lngRow = 1
With Worksheets("Gesamt")
.UsedRange.Delete
For Each wks In Worksheets(Array("Tabelle1", "Tabelle2", "Tabelle3", "Tabelle4"))
wks.Range("A1").CurrentRegion.Copy .Cells(lngRow, 1)
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Next wks
End With
End Sub

Sub CopyGesamt() Dim lngRow As Long, X As Long lngRow = 1 With Worksheets("Gesamt") .UsedRange.Delete For X = 1 To Worksheets.Count If Worksheets(X).Name "Gesamt" Then Worksheets(X).Range("A1").CurrentRegion.Copy .Cells(lngRow, 1) lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 End If Next End With End Sub

Option Explicit Sub CopyGesamt() Dim lngRow As Long, X As Long lngRow = 1 With Worksheets("Gesamt") .UsedRange.Delete For X = 1 To Worksheets.Count If Worksheets(X).Name = "Tabelle1" Or Worksheets(X).Name = "Tabelle2" Or Worksheets(X). _ Name = "Tabelle3" Or Worksheets(X).Name = "Tabelle4" Then Worksheets(X).Range("A1").CurrentRegion.Copy .Cells(lngRow, 1) lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 End If Next End With End Sub

Beliebteste Forumthreads (12 Monate)

Kopieren auf 4 Tabellen ausweiten -

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopieren auf 4 Tabellen ausweiten -

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread