Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1312to1316
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

Daten in eine Gesamt-Tabelle - Code abändern

Daten in eine Gesamt-Tabelle - Code abändern
20.05.2013 09:48:19
rieckmann
Hallo,
ich habe hier einen Code der sämtliche Datensätze mehrere Tabellen ab Zeile 2,
in ein Tabellenblatt "Gesamt" , beim aufrufen des Blattes, zusammenfügen soll.
Das klappt auch sehr gut, nur werden die Daten jedes Mal unten dran gehängt,
und die Zeilenhöhe wird nicht mitkopiert.
Beim Aufrufen des Tabellenblattes "Gesamt" müssten erst die gesamten Daten aus diesem Blatt ab Zeile 2 gelöscht werden, und dann erst die Daten aus den anderen Blättern hineinkopiert werden.
Nach Möglichkeit auch mit der original Zeilenhöhe.
Ist das machbar ?
Hier der Code:
Private Sub Worksheet_Activate()
Dim dst As Worksheet, iWS%
Dim lRow&, lStartRow&, lLastRow&
Set dst = ThisWorkbook.Worksheets("Gesamt") ' Zieltabelle
lStartRow = 2 ' Ab Zeile
For iWS = 1 To ThisWorkbook.Worksheets.Count
With ThisWorkbook.Worksheets(iWS)
If .Name  dst.Name Then
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Rows(lStartRow), .Rows(lLastRow)).Copy
lLastRow = dst.Cells(.Rows.Count, 1).End(xlUp).Row
dst.Rows(lLastRow).PasteSpecial Paste:=xlValues
End If
End With
Next iWS
End Sub

Gruß
Fred

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten in eine Gesamt-Tabelle - Code abändern
20.05.2013 10:09:36
Gerd
Hallo Fred!
So?
Private Sub Worksheet_Activate()
Dim dst As Worksheet, iWS%
Dim lRow&, lStartRow&, lLastRow&
Set dst = ThisWorkbook.Worksheets("Gesamt") ' Zieltabelle
dst.UsedRange.Offset(1, 0).Clear
lStartRow = 2 ' Ab Zeile
For iWS = 1 To ThisWorkbook.Worksheets.Count
With ThisWorkbook.Worksheets(iWS)
If .Name  dst.Name Then
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Rows(lStartRow), .Rows(lLastRow)).Copy
lLastRow = dst.Cells(.Rows.Count, 1).End(xlUp).Row + 1
dst.Rows(lLastRow).PasteSpecial Paste:=xlPasteAll
End If
End With
Next iWS
End Sub

Gruß Gerd

Anzeige
AW: Daten in eine Gesamt-Tabelle - Code abändern
20.05.2013 10:27:17
rieckmann
Hallo Gerd,
ja super so geht es.
Vielen Dank und Gruß
Fred

ein bisschen spät, ...
20.05.2013 10:30:24
Erich
Hi Fred,
... aber vielleicht doch auch noch nützllich:

Private Sub Worksheet_Activate()
Dim lStartRow As Long, lLastRow As Long
Dim wks As Worksheet, lAnzRow As Long
' Zielblatt vor dem Kopieren
lStartRow = 2     ' im Zielblatt ab Zeile
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
' Schleife über Blätter
For Each wks In ThisWorkbook.Worksheets
If wks.Name  Name Then
lAnzRow = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
wks.Cells(1, 1).Resize(lAnzRow).EntireRow.Copy Cells(lStartRow, 1)
lStartRow = lStartRow + lAnzRow
End If
Next wks
' evtl. Rest löschen
If lStartRow 
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: ein bisschen spät, ...
20.05.2013 10:58:55
rieckmann
Hallo Gerd und Erich,
ein Problem ist noch aufgetaucht !
Wenn eines der zu kopierenden Tabellenblätter bis auf die Überschriftenzeile leer ist,
wird die Überschriftenzeile mit in das Gesamt-Blatt kopiert.
Obwohl ja lStartRow = 2 gesetzt ist.
Wie kann das denn angehen ?
Gruß
Fred

und dann noch falsch...
20.05.2013 12:07:52
Erich
Hi Fred,
dass die 1. Zeile nicht zu kopieren war, hatte ich übersehen...

Private Sub Worksheet_Activate()
Dim lStartRow As Long, lLastRow As Long
Dim wks As Worksheet, lAnzRow As Long
' Zielblatt vor dem Kopieren
lStartRow = 2     ' im Zielblatt ab Zeile
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
' Schleife über Blätter
For Each wks In ThisWorkbook.Worksheets
If wks.Name  Name Then
lAnzRow = wks.Cells(Rows.Count, 1).End(xlUp).Row - 1
If lAnzRow > 0 Then
wks.Cells(2, 1).Resize(lAnzRow).EntireRow.Copy Cells(lStartRow, 1)
lStartRow = lStartRow + lAnzRow
End If
End If
Next wks
' evtl. Rest löschen
If lStartRow 
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: Daten in eine Gesamt-Tabelle - Code abändern
20.05.2013 11:44:49
Gerd
Hallo Fred!
Private Sub Worksheet_Activate()
Dim dst As Worksheet, iWS%
Dim lRow&, lStartRow&, lLastRow&
Set dst = ThisWorkbook.Worksheets("Gesamt") ' Zieltabelle
dst.UsedRange.Offset(1, 0).Clear
lStartRow = 2 ' Ab Zeile
For iWS = 1 To ThisWorkbook.Worksheets.Count
With ThisWorkbook.Worksheets(iWS)
If .Name  dst.Name Then
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lLastRow > 1 Then
.Range(.Rows(lStartRow), .Rows(lLastRow)).Copy
lLastRow = dst.Cells(dst.Rows.Count, 1).End(xlUp).Row + 1
dst.Rows(lLastRow).PasteSpecial Paste:=xlPasteAll
End If
End If
End With
Next iWS
End Sub
Gruß Gerd

Anzeige
AW: Daten in eine Gesamt-Tabelle - Code abändern
20.05.2013 12:48:44
rieckmann
Hallo Gerd,
super so wollte ich es haben.
Gruß
und Dank
Fred

AW: Daten in eine Gesamt-Tabelle - Code abändern
20.05.2013 12:56:10
rieckmann
Ich habe es noch Mal ein wenig beschleunigt !
Auch ein Tipp hier aus dem Forum !
Private Sub Worksheet_Activate()
Dim StatusCalc
Dim dst As Worksheet, iWS%
Dim lRow&, lStartRow&, lLastRow&
'Makrobremsen lösen - Am beginn eine sMakros
With Application
.EnableEvents = False
StatusCalc = .Application.Calculation 'Aktuellen Berechnungsmodus merken
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
' Hauptprozedur
Set dst = ThisWorkbook.Worksheets("Gesamt") ' Zieltabelle
dst.UsedRange.Offset(1, 0).Clear
lStartRow = 2 ' Ab Zeile
For iWS = 1 To ThisWorkbook.Worksheets.Count
With ThisWorkbook.Worksheets(iWS)
If .Name  dst.Name Then
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lLastRow > 1 Then
.Range(.Rows(lStartRow), .Rows(lLastRow)).Copy
lLastRow = dst.Cells(dst.Rows.Count, 1).End(xlUp).Row + 1
dst.Rows(lLastRow).PasteSpecial Paste:=xlPasteAll
End If
End If
End With
Next iWS
Range("A2").Select
Beenden: 'Sprungadresse zum Beenden diese Makros - nicht mit Exit Sub arbeiten!!
'Makrobremsen zurücksetzen - vor dem Beenden eines Makros
With Application
.EnableEvents = True
.Calculation = StatusCalc
.ScreenUpdating = True
End With
End Sub

Anzeige

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige