Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1504to1508
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zusammenfassung

Zusammenfassung
04.08.2016 09:45:15
Herbert
Hallo,
Ich möchte auf dem Tabellenblatt "Rekap" jeweils die Zeile 100 der anderen Tabellenblätter übernehmen. Die Auflistung sollte bei der Zelle A5 des Tabellenblattes "Rekap" beginnen. Mein File hat eine variable Anzahl von Tabellenblättern.
Ich wäre Euch wirklich dankbar wenn mit jemand helfen könnte.
Gruss
Herbert

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zusammenfassung
04.08.2016 10:07:06
baschti007
So Müsste das gehen
Gruß BAsti
Sub Zu()
Dim w As Worksheet
Dim I As Long
I = 5
For Each w In ThisWorkbook.Worksheets
If Not w.Name = "Rekap" Then
w.Rows(100).Copy Worksheets("Rekap").Range("A" & I)
I = I + 1
End If
Next
End Sub

AW: Zusammenfassung
04.08.2016 10:11:09
Gerd
Hallo Herbert!
Sub test2()
Dim oBlatt As Worksheet
For Each oBlatt In ThisWorkbook.Worksheets
If oBlatt.Name  "Rekap" Then
With ThisWorkbook.Worksheets("Rekap")
.Rows(Application.Max(5, .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row)).Value = oBlatt. _
Rows(100).Value
End With
End If
Next
End Sub
Gruß Gerd
Anzeige
AW: Zusammenfassung
04.08.2016 10:44:54
Herbert
Hallo Gerd und Basti,
Es funktionniert. Super ihr seid mir eine echte Hilfe.
Gruss
Herbert
AW: Zusammenfassung
04.08.2016 10:11:29
Michael
Hallo Herbert!
Eine Möglichkeit:
Sub a()
Dim Wb As Workbook
Dim WsZ As Worksheet
Dim WsQ As Worksheet
Dim i As Long
Dim clc
With Application
.ScreenUpdating = False
clc = .Calculation
.Calculation = xlCalculationManual
End With
Set Wb = ThisWorkbook
Set WsZ = ThisWorkbook.Worksheets("Rekap")
i = 0
With Wb
For Each WsQ In .Worksheets
If WsQ.Name  "Rekap" Then
With WsQ
.Rows(100).Copy
WsZ.Cells(5 + i, 1).PasteSpecial xlPasteValues
i = i + 1
End With
End If
Next WsQ
End With
With Application
.CutCopyMode = False
.ScreenUpdating = True
.Calculation = clc
End With
End Sub
LG
Michael
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige