Microsoft Excel

Herbers Excel/VBA-Archiv

Tabellenblätter zusammenführen, aber | Herbers Excel-Forum


Betrifft: Tabellenblätter zusammenführen, aber von: Christo
Geschrieben am: 19.01.2012 06:00:20

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

  

Betrifft: AW: Tabellenblätter zusammenführen, aber von: Dirk aus Dubai
Geschrieben am: 19.01.2012 06:27:40

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


  

Betrifft: Tabellenblätter zusammenführen von: Erich G.
Geschrieben am: 19.01.2012 07:38:29

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


  

Betrifft: AW: Tabellenblätter zusammenführen von: Christo
Geschrieben am: 19.01.2012 08:52:40

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



  

Betrifft: kleine Änderung von: Erich G.
Geschrieben am: 19.01.2012 09:07:13

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


  

Betrifft: AW: kleine Änderung von: Christo
Geschrieben am: 20.01.2012 07:20:27

Besten Dank.
funkioniert Super.


Beiträge aus den Excel-Beispielen zum Thema "Tabellenblätter zusammenführen, aber"