Daten automatisch in ein anderes Tabellenblatt schreiben

[knallebumm]

Hallo,
ist es möglich in einer Arbeitsmappe mit 9 Blättern das alle eingegebenen Daten automatisch in ein 10es Blatt übernommen werden.
Und zwar der Reihe nach von 1-9, also erst alle Daten von Blatt 1, dann Blatt 2 usw.
Wenn in einem Blatt Daten geändert werden sollen die sich in Blatt 10 natürlich auch ändern.
Die Tabellen beginnen bei A3 - I3 Blatt 1 - 9

Auf Blatt 10 sollen sie in B5 - J5 eingetragen werden mit einem Kürzel in A5 aus welchem Blatt die Daten kommen

Wenn dies nicht gehen sollte würde ich mich über ein kurzes das geht nicht genauso freuen wie über eine Lösung

Gruß
Thomas



  Einteilung.xlsm (Größe: 78,64 KB / Downloads: 14)

[Kuwer]

Hallo Thomas,

kopiere den Code in das schon vorhandene VBA-Modul der Gesamttabelle:

Code:

Private Sub Worksheet_Activate()
  Dim i As Long
  Dim varQ As Variant
  Me.Range(Me.Cells(5, 1), Me.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 10)) = ""
  For i = 1 To 9
    With Worksheets(i)
      If Len(.Cells(3, 1)) Then
        varQ = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 9).Value
      Else
        ReDim varQ(0)
      End If
    End With
    If UBound(varQ) Then
      With Me.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(varQ))
        .Value = Worksheets(i).Name
        .Offset(, 1).Resize(, UBound(varQ, 2)).Value = varQ
      End With
    End If
  Next i
End Sub

Gruß Uwe

[knallebumm]

Hallo Uwe,
vielen Dank dafür.
Es funktioniert aber nur teilweise, d.h. es werden nur die Daten der ersten drei Blätter übernommen.
Und weiter läuft mein Makro zum Speichern nicht mehr.
Ohne dein Makro laufen alle Makros ohne Probleme, wenn ich deines in dem Blatt eingefügt habe kommt beim Speichern ( strg+y) die Meldung Laufzeitfehler '9' Index ausserhalb des gültigen Bereichs.

Ich hänge die Originaltabelle mit allen Makros mal mit an, da ich den Fehler sowieso nicht finden werde.

Gruß
Thomas



  Einteilung 2.xlsm (Größe: 141,04 KB / Downloads: 14)

[Kuwer]

Hallo Thomas,

das Makro funktioniert, also es holt Daten aus den Blättern,
wenn die jeweilige Zelle A3 nicht leer ist. Du solltest die Blätter
4 bis 9 daraufhin noch einmal überprüfen!

Wegen des Fehlers:
Lösche das Makro im Modul der Tabelle "Einteilung alle Ligen"
und füge in das Modul "DieseArbeitsmappe" folgenden Code ein:

Code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  Dim i As Long
  Dim varQ As Variant
  If Sh.Name = "Einteilung alle Ligen" Then
    Sh.Range(Sh.Cells(5, 1), Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 10)) = ""
    For i = 1 To 9
      With Worksheets(i)
        If Len(.Cells(3, 1)) Then
          varQ = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 9).Value
        Else
          ReDim varQ(0)
        End If
      End With
      If UBound(varQ) Then
        With Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(varQ))
          .Value = Worksheets(i).Name
          .Offset(, 1).Resize(, UBound(varQ, 2)).Value = varQ
        End With
      End If
    Next i
  End If
End Sub

Gruß Uwe

[knallebumm]

Hallo Uwe,
vielen Dank es rockt.
Man sollte schon aufpassen wenn man das Blatt öffnet in welcher Zeile sich die Maus befindet:29:.
Mit dem Speichern klappt jetzt auch.

Gruß
Thomas