EXCEL VBA aus fast allen Tabelle dynam. Bereich nach Tabelle 1 Kopieren

[kleiner1958]

Hallo,
ich habe nun schon mehrere Tage versucht dieses Thema zu knacken, leider vergeblich.
Ich habe eine Excel-Datei mit 47 Tabellen.
Der Struktur / Aufbau der Tabellen ist gleich bis auf die Länge der Spalten (immer unterschiedlich)
Ausnahme Tabelle1- dort sollen die Werte aus den dynamischen Bereichen der anderen Tabellen unter einander zusammengefasst werden.
Aus den Tabellen 2 bis 47 sollen aus dem Bereich die Werte in Tabelle1 in Spalte A fortlaufend rein geschrieben werden.
Es gibt in diesen dynamischen Bereichen keine leeren Zellen in den zu kopierenden Bereichen.


Nach dem 40-zigsten Fehlvesuch wende ich mich nun an Euch - mit der Hoffnung das bei Euch Hilfe drin ist.
Hier der Rest meiner Programmierversuche:



Sub AlleBereicheUebertragen()
  Dim sh As Worksheet
  Dim D As Tabelle1
  Dim letzteZeileZiel As Range
  Dim letzteZeileQuelle As Range
  Dim InI As Integer


For InI = Sheets.Count To 1 Step -1
'   alle Tabellenblätter sichtbar?
    If Sheets(InI).Name <> "Tabelle1" Then Sheets(InI).Visible = True

             ' Spalte i der Tabelle(Ini) soll von Zeile 1000 nach 0 auf Spaltenende untersucht werden
             letzteZeileQuelle = ActiveSheet.Cells(1000, 9).End(xlUp).Row
             ' muß dieses Select sein, da ich hier immer wieder hängen bleibe
             ActiveWorkbook.Sheets(InI).Select
             ' die Spalte i ist ab I4 bis I35 (maximal) belegt) dieser Bereich soll zum Kopieren ausgewählt werden
                   Range(("I4"), ActiveWorkbook.Range(Cells("I"), Range(Cells.End(xlUp).Row), 9)).Select

             With Selection
            ' mit der Auswahl soll die Spalte A-Ende fortlaufend gefüllt werden
            ' da in den Quell-Zellen Formelergebnisse stehen soll - ausgeführt werden
                Sheets("Tabelle1").Range((Cells.End(xlUp).Row), 1).PasteSpecial Paste:=xlPasteValues
            ' dieInhalte der Quellzellen sollen bestehen bleiben
                Application.CutCopyMode = False
       
    

Next Sheets(InI)


End Sub


Vielen Dank im Voraus für Eure Hilfe

[Fennek]

Hallo,

das Sheet für die Zusammenfassung muss ganz links, also Sheets(1) sein.

Code:

sub Test
for i = 2 to sheets.count
    sheets(i).usedrange.copy sheets(1).cells(rows.count,1).end(xlup).offset(1)
next i
end sub

ungeprüft

mfg

[kleiner1958]

Hallo,
also der Vorschlag von Fennek hat bei mir nicht funktioniert.
Aber ich bin nach etwas Schlaf und bisschen Walkout wieder besser drauf und habe das unten stehende zusammengefummelt.
Es funktioniert, soweit   - aber es wird nicht mit allen Tabellenblättern abgearbeitet - soweit ich das sehe erfolgt die Abarbeitung nicht nach dem Tabellennamen im Objektkatalog (also Tabelle47 Rückwärtsschritte minus1 nach Tabelle1. Z.Bsp von Oben nach unten steht Tabelle 1, Tabelle10, Tabelle11, usw. es wird als bei Tabelle47 angefangen, da fehlen dann die Tabellen 5,6,7,8 und 9
Wie kann ich das Ändern, so dass die interne Bezeichnung der Tabelle genutzt wird und wirklich von Tabelle47 nach Tabelle1 gearbeitet wird??

____
hier der Code
___________

Code:

Sub AlleBereicheuebertragen()
 Dim sh As Worksheet
 Dim InI As Integer
Dim wbkOpen As Workbook
Dim rngQuelle As Range
Dim rngZiel As Range
Dim letzteZeile As Long
Dim letzteZeileZiel As Long

'   schon beim Anlaufen muss die Letzte Zeile in Spalte "A" der Tabelle1 bestimmt werden
            Worksheets("Mitglieder").Activate
            letzteZeileZiel = ActiveSheet.Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Row


For InI = sheets.Count To 1 Step -1

          sheets(InI).Activate
                      
            ' letzte Zeile in Spalte - jetzt klappt es mit der Bestimmung der letzten Zeile in Spalte "I"
            letzteZeile = ActiveSheet.Range(Cells(9, 4), Cells(Rows.Count, 9).End(xlUp)).Row
''''''            'letzteZeile = ThisWorkbook.sheets(InI).Range(Cells(9, 4), Cells(Rows.Count, 9).End(xlUp)).Row
            
            
'            Range(Cells(9, 4), letzteZeile).Copy
            ActiveSheet.Range(Cells(4, 9), Cells(ActiveSheet.Cells(Rows.Count, 9).End(xlUp).Row, 9)).Copy
            'sheets(InI).Range(Cells(4, 9), Cells(ActiveSheet.Cells(Rows.Count, 9).End(xlUp).Row, 9)).Copy
            'Application.CutCopyMode = False
            'Worksheets("Mitglieder").Range(Cells("A", letzteZeileZiel)).PasteSpecial xlPasteValues
            sheets("Mitglieder").Cells(letzteZeileZiel, 1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
                       
     
            sheets("Mitglieder").Activate
            letzteZeileZiel = ActiveSheet.Range(Cells(100, 1), Cells(Rows.Count, 1).End(xlUp)).Row
            sheets(InI).Activate
            
        
Next InI
        Worksheets("Mitglieder").Select
End Sub