Mehrere Tabellenblätter in ein anderes Blatt kopieren

Hallo,

ich möchte die Tabellenblätter "01", "02", "03", "04","05", "06", "07", "08", "09", "10", "11", "12" (jeweils mit unterschiedlicher Länge) mit den Spalten A bis einschließlich i hintereinander in das vorhandene Tabellenblatt "Liste" kopieren. Die o.g. Tabellenblätter sollen ab Zeile 2 kopiert werden und beginnend im Tabellenblatt "Liste" hintereinander ab Zeile 2 eingefügt werden.
Dann sollen alle eingefügten Werte im Tabellenblatt "Liste" nach der Spalte "A" sortiert werden.
Schön wäre es, wenn danach das Tabellenblatt "Liste" noch nach zwei Kriterien gefiltert werden könnte: 1) Zellen in Spalte G haben einen Wert größer als 0 und 2) Zellen in Spalte i sind leer.

Über eine Lösung würde ich mich freuen.

Mit freundlichen Grüßen

Gerd

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Gerd

Teste mal bitte:

Sub DatenKopieren()
Dim wsListe As Worksheet
Dim wsQuelle As Worksheet
Dim i As Integer
Dim letzteZeile As Long

' Zielblatt "Liste" festlegen
Set wsListe = ThisWorkbook.Sheets("Liste")

' Alle gewünschten Quellblätter durchlaufen
For i = 1 To 12
' Quellblatt festlegen
Set wsQuelle = ThisWorkbook.Sheets(Format(i, "00"))

' Letzte Zeile im Quellblatt ermitteln
letzteZeile = wsQuelle.Cells(wsQuelle.Rows.Count, "A").End(xlUp).Row

' Daten kopieren
wsQuelle.Range("A2:I" & letzteZeile).Copy Destination:=wsListe.Cells(wsListe.Cells(wsListe.Rows.Count, "A").End(xlUp).Row + 1, "A")
Next i

' Daten in "Liste" sortieren
wsListe.Sort.SortFields.Clear
wsListe.Sort.SortFields.Add Key:=Range("A2:A" & wsListe.Cells(wsListe.Rows.Count, "A").End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wsListe.Sort
.SetRange Range("A1:I" & wsListe.Cells(wsListe.Rows.Count, "A").End(xlUp).Row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' Filter anwenden
wsListe.Range("A1:I" & wsListe.Cells(wsListe.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=7, Criteria1:=">0"
wsListe.Range("A1:I" & wsListe.Cells(wsListe.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=7, Criteria1:=">2"
wsListe.Range("A1:I" & wsListe.Cells(wsListe.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=9, Criteria1:=""
End Sub

Gruss

Raimund

Sub Unit() Dim a As Integer With Sheets("Liste") For a = 1 To 12 Sheets(Format(a, "00")).Cells(2, 1).Resize(Sheets(Format(a, "00")).Cells(Rows.Count, 1).End(xlUp).Row - 1, 9).Copy _ Destination:=.Cells(Rows.Count, 1).End(xlUp).Offset(1) Next a With .Range("A:I") .Sort Key1:=Sheets("Liste").Cells(2, 1), Order1:=xlAscending, Header:=xlGuess .AutoFilter .AutoFilter field:=7, Criteria1:=">0" .AutoFilter field:=9, Criteria1:="" End With End With End Sub

Sub Unit() Dim a As Integer For a = 1 To 12 Sheets(Format(a, "00")).Cells(2, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 9).Copy _ Destination:=Sheets("Liste").Cells(Rows.Count, 1).End(xlUp).Offset(1) Next Sheets("Liste").Range("A:I").AutoFilter Sheets("Liste").Range("A:I").AutoFilter field:=7, Criteria1:=">0" Sheets("Liste").Range("A:I").AutoFilter field:=9, Criteria1:="" End Sub

Beliebteste Forumthreads (12 Monate)

Mehrere Tabellenblätter in ein anderes Blatt kopieren

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mehrere Tabellenblätter in ein anderes Blatt kopieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread