Inhalt von Tabellenblättern in neues Blatt kopiere

Forumthread: Inhalt von Tabellenblättern in neues Blatt kopiere

15.10.2013 13:15:35

Tabellenblättern

Hallo,
ich habe ein größeres Problem. Ich muss täglich eien Auswertung erstellen. Dazu sollen alle Zeilen aus allen Tabellenblättern einer Exceldatei, die in der Spalte D einen bestimmten Wert stehen haben in einem einzigen Tabellenblatt einer anderen Datei zusammenkopiert werden. Die Tabellenblätter der Quelldatei sind mit dem jeweiligen Tagesdatum benannt. Dieses Datum soll beim Zusammenkopieren der entsprechenden Zeile zugefügt werden. Die Quelldatei ist freigegeben und liegt auf einem Netzlaufwerk.
Da die Daten in der Quelldatei auch nachträglich verändert werden sollte das Ergebnis in der Zieldatei be jedem aktualisieren komplett überschrieben werden.
Ich bin für jede Hilfe dankbar...
mfg
Oliver W
Beispiel der Quelldatei https://www.herber.de/bbs/user/87657.xlsx
Beispiel der Zieldatei https://www.herber.de/bbs/user/87658.xlsx

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Inhalt von Tabellenblättern in neues Blatt kopiere

16.10.2013 12:26:43

Tabellenblättern
AW: Inhalt von Tabellenblättern in neues Blatt kopiere

18.10.2013 10:46:30

Tabellenblättern

AW: Inhalt von Tabellenblättern in neues Blatt kopiere

16.10.2013 12:26:43

Tabellenblättern

Hallo
so z.B.
- Beide Dateien sind geöffnet
- Makro muss in die Zieldatei


Sub TT()
On Error GoTo Fehler
Dim WB1, WB2, TB1, TB2
Dim LR1&, LR2&, Rng
Dim CC%, Zelle
Set WB1 = Workbooks("Datei1.xlsx")
Set WB2 = ThisWorkbook
Application.ScreenUpdating = False
Set TB2 = WB2.Sheets("Zusammenfassung Test1")
LR2 = TB2.Cells(Rows.Count, 1).End(xlUp).Row + 1
TB2.Rows("2:" & LR2).Delete
LR2 = 2
For Each TB1 In WB1.Worksheets
LR1 = TB1.Cells(Rows.Count, 1).End(xlUp).Row ' Gesamtsumme bleibt unberücksichtigt
CC = TB1.Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte des gesamten  _
Blattes
On Error Resume Next ' notwendig, wenn keine Daten
Set Rng = TB1.Range("D8:D" & LR1).SpecialCells(xlCellTypeConstants, 3)
For Each Zelle In Rng
If Err.Number  1004 Then
TB2.Range("A" & LR2) = TB1.Name
TB1.Range(TB1.Cells(Zelle.Row, 1), TB1.Cells(Zelle.Row, CC)).Copy _
TB2.Range("B" & LR2)
LR2 = LR2 + 1
Else ' wenn keine Daten vorhanden
Err.Clear
On Error GoTo Fehler
End If
Next
Next
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Gruß UweD

AW: Inhalt von Tabellenblättern in neues Blatt kopiere

18.10.2013 10:46:30

Tabellenblättern

Hallo Uwe,
danke für die Antwort. Bin leider erst heute dazu gekommen es zu probieren. Leider kommt beim Ausführen "Fehler 9 Index außerhalb des gütigen Bereichs"
mfg Oliver

Beliebteste Forumthreads (12 Monate)

Inhalt von Tabellenblättern in neues Blatt kopiere

Forumthread: Inhalt von Tabellenblättern in neues Blatt kopiere

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread