Microsoft Excel

Herbers Excel/VBA-Archiv

Inhalte von Tabellenblätter untereinander

Betrifft: Inhalte von Tabellenblätter untereinander von: stormlamp
Geschrieben am: 02.10.2014 15:19:45

Hallo,

ich habe eine Mappe mit ca. 30 Tabellenblättern.
Aus diesen Tabellenblättern möchte ich gerne Daten zusammenführen.

Dazu sollen in einem neuen Tabellenblatt "Tabellenliste" die Namen der Tabellenblätter untereinander stehen, deren Daten alle auf ein Tabellenblatt "Zusammenfassung" importiert werden. Im Script möchte ich dazu je Tabellen eine gültige Start- und Endespalte angeben, bspw. D und AX und eine Startzeile bspw. 8

Tabelle1 D AX 8
Tabelle4 D AX 12
Tabelle6 E AY 5
.
.
.

Das Script soll nun aus allen aufgelisteten Tabellen beginnend mit Tabelle 1 alle Werte von D8 bis letzte gefüllte Zelle in Spalte AX in die Tabelle "Zusammenfassung" ab B1 kopieren. Danach das Gleiche mit Tabellle 4 D12 bis AX Ende, Tabelle 6 E5 bis AY ende etc. und alle Blöcke untereinander schreiben.

Kann mir bitte jemand dabei helfen.

Gruß
Hans

  

Betrifft: VBA-Sammler von: Erich G.
Geschrieben am: 02.10.2014 17:17:09

Hi Hans,
probiers mal damit:

Option Explicit

Sub Sammler()
   Dim arW(1 To 35) As String, arV(1 To 35) As String, ii As Long, cc As Long
   Dim arB(1 To 35) As String, arZ(1 To 35) As Long, zz As Long, qq As Long

   ii = ii + 1: arW(ii) = "Tabelle1": arV(ii) = "D": arB(ii) = "AX": arZ(ii) = 8
   ii = ii + 1: arW(ii) = "Tabelle4": arV(ii) = "D": arB(ii) = "AX": arZ(ii) = 12
   ii = ii + 1: arW(ii) = "Tabelle6": arV(ii) = "E": arB(ii) = "AY": arZ(ii) = 5

   zz = 1                                 ' 1. Zielzeile
   For ii = 1 To UBound(arW)              ' Schleife über Blätter
      If arW(ii) = "" Then Exit For
      With Sheets(arW(ii))
         qq = .Cells(.Rows.Count, arV(ii)).End(xlUp).Row - arZ(ii) + 1
         cc = Range(arV(ii) & ":" & arB(ii)).Columns.Count
         Sheets("Zusammenfassung").Cells(zz, 2).Resize(qq, cc) = _
            .Cells(arZ(ii), arV(ii)).Resize(qq, cc).Value2
         zz = zz + qq
      End With
   Next ii
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: AW: VBA-Sammler von: stormlamp
Geschrieben am: 02.10.2014 17:59:57

Hallo Erich,

im Ansatz funktioniert es, jedoch noch nicht ganz.

Einmal würde ich gerne die Werte, die jetzt fest im Code stehen:

ii = ii + 1: arW(ii) = "Tabelle1": arV(ii) = "D": arB(ii) = "AX": arZ(ii) = 8
   ii = ii + 1: arW(ii) = "Tabelle4": arV(ii) = "D": arB(ii) = "AX": arZ(ii) = 12
   ii = ii + 1: arW(ii) = "Tabelle6": arV(ii) = "E": arB(ii) = "AY": arZ(ii) = 5
wie geschrieben aus einem Tabellenblatt "Tabellenliste" einlesen,
in der Spalte A stehen die Tabellennamen, in Spalte B die Startspalte, in C die Endspalte und in D die Startzeile.

Die erste Tabelle wird komplett und richtig übertragen, aber ab dem zweiten Tabellenblatt fehlt bei jeder Übertragung das erste Zeichen, das jeweils eine "0" ist. Es werden die Formate nicht mitgenommen. Wenn ich in der Zieltabelle die Spalte als Text vorab definiere, dann wird die führende "0" mitgenommen.

Letzte Frage: Wo steht die Zielstelle "B1", wenn ich das einmal variieren möchte?

Gruß
Hans


  

Betrifft: VBA-Sammler 2 von: Erich G.
Geschrieben am: 03.10.2014 01:24:37

Hi Hans,
dann probiers mal hiermit:

Option Explicit

Sub Sammler2()
   Dim arW, ii As Long, cc As Long, zz As Long, qq As Long

   With Sheets("Tabellenliste")                             ' Vorgabeliste
      arW = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 4)
   End With
   zz = 1                                                   ' 1. Zielzeile
   For ii = 1 To UBound(arW)                                ' Schleife über Blätter
      If arW(ii, 1) <> "" Then
         With Sheets(arW(ii, 1))
            qq = .Cells(.Rows.Count, arW(ii, 2)).End(xlUp).Row - arW(ii, 4) + 1
            cc = Range(arW(ii, 2) & ":" & arW(ii, 3)).Columns.Count
            .Cells(arW(ii, 4), arW(ii, 2)).Resize(qq, cc).Copy _
               Sheets("Zusammenfassung").Cells(zz, 2)       ' Zielspalte 2 = B
            zz = zz + qq                                    ' neue Zielzeile zz
         End With
      End If
   Next ii
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich


  

Betrifft: Gelöst: VBA-Sammler 2 von: stormlamp
Geschrieben am: 03.10.2014 09:11:16

Hallo Erich,

vielen Dank für die Hilfe und das tolle Script es funktioniert perfekt und lässt sich nun auch ausgezeichnet auf verschiedene Konstellationen anpassen.

Auch die Formatierungen kommen jetzt sauber mit rüber.

Ein Hindernis habe ich noch festgestellt:
Wenn auf einem Tabellenblatt ein Filter gesetzt ist, dann werden nur die gefilterten Zeilen kopiert.
Lässt sich das umgehen oder muss ich vorher manuell alle Auofilter zurücksetzen, dass keine Werte mehr ausgefiltert werden und auch alle Zeilen kopiert werden?

Freundliche Grüße
Hans


  

Betrifft: AutoFilter ausschalten von: Erich G.
Geschrieben am: 03.10.2014 10:52:12

Hi Hans,
du kannst den AutoFilter auch auschalten lassen. Ergänz doch mal im Code
die zweite folgende Zeile:

         With Sheets(arW(ii, 1))
            If .AutoFilterMode Then .AutoFilterMode = False ' Autofilter ausschalten
            qq = .Cells(.Rows.Count, arW(ii, 2)).End(xlUp).Row - arW(ii, 4) + 1

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Schönen Feiertag, schönes WoEnde allerseits!


  

Betrifft: AW: AutoFilter ausschalten von: stormlamp
Geschrieben am: 03.10.2014 22:19:28

Hall Erich,

den Autoschalter habe ich mit diesem Code schon ausgeschaltet:

Dim ws  As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    If ws.FilterMode Then
        ws.ShowAllData
    End If
Next ws
Das mache ich allerdings ungerne, da in allen Tabellen die Autofilter anders eingestellt sind und anschließend wieder alle zu Fuß gesetzt werden müssen. Ich hatte gehofft, es gibt einen Code, alle gefüllten Zeilen zu kopieren, auch wenn ein Teil durch Autofilter ausgeblendet ist.

Jedenfalls vielen Dank und ein schönes Wochenende
Hans


 

Beiträge aus den Excel-Beispielen zum Thema "Inhalte von Tabellenblätter untereinander"