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

Tabellenblätter zusammenführen, aber

Tabellenblätter zusammenführen, aber
Christo
Hallo,
das folgende Makro funktioniert fast perfekt, bloss ...
- die Titelzeilen 1-5 der "Herkunftstabelle" werden immer mitkopiert
- im Zielblatt sollte in der Spalte "S" bei jedem Datensatz, die Herkunftstabelle stehen
( Die Daten der Herkunftstabellen haben im Maximum Spalten von A - P
Wer weiss Rat und jetzt schon Danke.
Christo
Sub Total_Tabelle()
Dim wksZ As Worksheet, wksQ As Worksheet, lngZ As Long, lngQ As Long
Set wksZ = Worksheets("Gesamt")   ' Zielblatt "Gesamt" muss existieren
lngZ = wksZ.Cells(wksZ.Rows.Count, 1).End(xlUp).Row
gesamt_Loeschen ' löscht den gesamten Inhalt in "Gesamt"
' erstellt die Titelzeile
For Each wksQ In Worksheets
With wksQ
If wksQ.Name = "Totale" Then GoTo sprung   ' wird nicht kopiert
If wksQ.Name = "IST_VERS" Then GoTo sprung ' wird nicht kopiert
If wksQ.Name = "IST_STRV" Then GoTo sprung ' wird nicht kopiert
If .Name  wksZ.Name Then
lngQ = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
If lngQ > 0 Then .Rows(2).Resize(lngQ).Copy wksZ.Rows(lngZ + 1)
lngZ = lngZ + lngQ
End If
sprung:
End With
Next wksQ
End Sub

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

Betreff
Benutzer
Anzeige
AW: Tabellenblätter zusammenführen, aber
19.01.2012 06:27:40
Dirk
Hallo!
Vieleicht so (ungetestet):
Sub Total_Tabelle()
Dim wksZ As Worksheet, wksQ As Worksheet, lngZ As Long, lngQ As Long
Set wksZ = Worksheets("Gesamt")   ' Zielblatt "Gesamt" muss existieren
lngZ = wksZ.Cells(wksZ.Rows.Count, 1).End(xlUp).Row
gesamt_Loeschen ' löscht den gesamten Inhalt in "Gesamt"
' erstellt die Titelzeile
For Each wksQ In Worksheets
With wksQ
If wksQ.Name = "Totale" Then GoTo sprung   ' wird nicht kopiert
If wksQ.Name = "IST_VERS" Then GoTo sprung ' wird nicht kopiert
If wksQ.Name = "IST_STRV" Then GoTo sprung ' wird nicht kopiert
If .Name  wksZ.Name Then
lngQ = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
If lngQ > 0 Then .Rows(6).Resize(lngQ).Copy wksZ.Rows(lngZ + 1)
wksz.cells(ingz,19).value = wksq.name
lngZ = lngZ + lngQ
End If
sprung:
End With
Next wksQ
End Sub
lass' hoeren, ob ok.
Gruss
Dirk aus Dubai
Anzeige
Tabellenblätter zusammenführen
19.01.2012 07:38:29
Erich
Hallo Dirk,
sorry, dass ich mich einmische.
Das "wksQ.Name" nach "With wksQ" war mir aufgefallen, "GoTo sprung" auch. Dann war da nich ein "ingz".
So hab ichs mal etwas umformuliert:

Sub Total_Tabelle()
Dim wksZ As Worksheet, wksQ As Worksheet, lngZ As Long, lngQ As Long
Set wksZ = Worksheets("Gesamt")   ' Zielblatt "Gesamt" muss existieren
lngZ = wksZ.Cells(wksZ.Rows.Count, 1).End(xlUp).Row
gesamt_Loeschen ' löscht den gesamten Inhalt in "Gesamt"
' erstellt die Titelzeile
For Each wksQ In Worksheets
With wksQ
Select Case .Name
Case "Totale", "IST_VERS", "IST_STRV", wksZ.Name ' werden nicht kopiert
Case Else
lngQ = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
If lngQ > 0 Then .Rows(6).Resize(lngQ).Copy wksZ.Rows(lngZ + 1)
wksZ.Cells(lngZ, 19).Value = .Name
lngZ = lngZ + lngQ
End Select
End With
Next wksQ
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
Anzeige
AW: Tabellenblätter zusammenführen
19.01.2012 08:52:40
Christo
Hallo Dirk und Erich,
fast klappt Alles.
Ich musste die Namen der Tabellen noch etwas ändern,
da immer neue Tabellen dazukommen und ich darum ein Makro für den Sort der Tabellen ausführen muss.
Leider klappt nicht, dass hinter jeder Zeile in Spalte 19 der Name der Herkunftstabelle geschrieben wird.
Danke
Christo
Sub Total_Blatt_zusammentragen()
Dim wksZ As Worksheet, wksQ As Worksheet, lngZ As Long, lngQ As Long
Set wksZ = Worksheets("1-Gesamt")   ' Zielblatt muss existieren
gesamt_Loeschen ' erstellt das Titelblatt
lngZ = wksZ.Cells(wksZ.Rows.Count, 1).End(xlUp).Row
For Each wksQ In Worksheets
With wksQ
Select Case .Name
Case "1_Totale", "1_IST_STRV", "1_IST_VERS", wksZ.Name ' werden nicht kopiert
Case Else
lngQ = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
If lngQ > 0 Then .Rows(6).Resize(lngQ).Copy wksZ.Rows(lngZ + 1)
wksZ.Cells(lngZ, 17).Value = .Name
lngZ = lngZ + lngQ
End Select
End With
Next wksQ
End Sub

Anzeige
kleine Änderung
19.01.2012 09:07:13
Erich
Hi,
vermutlich musst du nur in einer Zeile ändern:
alt:
wksZ.Cells(lngZ, 17).Value = .Name ' Wie kamst du hier auf 17? S ist 19.
neu:
wksZ.Cells(lngZ, 19).Resize(lngQ).Value = .Name
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
AW: kleine Änderung
20.01.2012 07:20:27
Christo
Besten Dank.
funkioniert Super.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige