Werte in Spalte suchen und Zeilen in anderes Blatt kopieren

[gaucho7]

Hallo! Ich habe ein Problem . Ich habe eine Datei mit 8 Arbeitsblättern. Blatt Übersicht ist die Quelldatei und enthält in der Spalte A die Positionen. Zu jeder Position sind in der gleichen Zeile in den Spalten B-H Informationen. Ich möchte die Position 1 in die Spalte A finden und die zugehörigen Zeilen A-E in Arbeitsblatt "Tabelle 1 kopieren (Anfang Spalte a Zeile3).Das gleiche für Position 2 --Tabelle2,Position3-->Tabelle3, usw...Die Unterpositionen (Gruppiert) sollen genauso kopiert werden. Das Ganze soll automatisch und ohne Eingaben funktionieren und auch dann wenn  ein neuer Eintrag kommt (z.B in der Position 2). Habe schon einiges ausprobiert, krieg es aber leider nicht hin. Im Anhang ist die Datei, bitte um Hilfe! Danke

[Egon12]

Hallo,

das sollte für deine Zwecke ausreichend sein:

Code:

Option Explicit

Sub Uebertragen()
    Dim i&, j&, k&, r&, lz&, tmp(), arrListe(): arrListe = Tabelle1.UsedRange.Value
    For i = 1 To 7
        For j = 1 To UBound(arrListe)
            If arrListe(j, 1) = i Then
                r = r + 1
                ReDim Preserve tmp(1 To UBound(arrListe, 2), 1 To r)
                For k = 1 To UBound(arrListe, 2)
                    tmp(k, r) = arrListe(j, k)
                Next k
            End If
        Next j
        With Sheets(i + 1)
            lz = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(lz, 1).Resize(UBound(tmp, 2), UBound(tmp, 1)) = Application.Transpose(tmp)
        End With
        r = 0
        Erase tmp
    Next i
End Sub

Gruß Uwe

[gaucho7]

Hallo Uwe, danke für Deine Hilfe! 
Funktioniert ganz gut, aber noch nicht ganz.Wenn ich jetzt z.B in die Position 2 einen neuen Eintrag mache, wird dieser Eintrag nicht automatisch in die Tabelle 2 kopiert.Erst wenn ich den Script manuell ausführe, taucht der Wert in der Tabelle2 auf, allerdings werden die vorhandenen Werte auch nochmal reinkopiert.

[Egon12]

Hallo,
 
was ich dir gezeigt habe ist das Gerüst zum zerdröseln auf die verschiedenen Tabellenblätter.
Aufrufen kannst du diese Prozedur über dasWorksheet_Change Ereignis im Modul der Tabelle1.
in Modul Tabelle1:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Uebertragen
End Sub

Dein Wunsch macht aber nur Sinn, wenn die Tabelle aufwächst.
Da käme in der i Schleife noch der Löschbefehl .ClearContents dazu.
in allgem. Modul:

Code:

Option Explicit
Sub Uebertragen()
    Dim i&, j&, k&, r&, lz&, tmp(), arrListe(): arrListe = Tabelle1.UsedRange.Value
    For i = 1 To 7
        For j = 1 To UBound(arrListe)
            If arrListe(j, 1) = i Then
                r = r + 1
                ReDim Preserve tmp(1 To UBound(arrListe, 2), 1 To r)
                For k = 1 To UBound(arrListe, 2)
                    tmp(k, r) = arrListe(j, k)
                Next k
            End If
        Next j
        With Sheets(i + 1)
            .Range("A2:H" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
            lz = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(lz, 1).Resize(UBound(tmp, 2), UBound(tmp, 1)) = Application.Transpose(tmp)
        End With
        r = 0
        Erase tmp
    Next i
End Sub

Gruß Uwe

[gaucho7]

Hallo Uwe Vielen Dank, funktioniert super. 
Eine Frage habe ich noch...wie ändere ich den Code falls sich die Namen der Tabellen ändern (nicht Tabelle1,Tabelle2,...sondern z.B.Tabelle1-->Deutschland, Tabelle2-->England,Tabelle3-->Japan...usw.?
Danke nochmals!

[Egon12]

Hallo,
 
So lang du nur dem Blattnamen änderst gar nicht.
Solltest du den Modulnamen ändern, braucht es eine Zuweisung (das kann z.B. ebenfalls in einem Array angelegt werden) welche Positionsnummer welchen Modulnamen zugeordnet werden soll.
 
Gruß Uwe

[RPP63]

EDIT: Sorry, ich war zu spät, lasse aber dennoch stehen.

Mich mal kurz einmischend:

Mit Sheets(i + 1) wird auf den Index der Sheets-Auflistung zugegriffen.
Die Auflistung beginnt in der "linken" Tabelle mit 1
Hierbei ist es irrelevant, welchen Namen das Tabellenblatt besitzt!

Man sollte allerdings die Struktur der Arbeitsmappe schützen.
(Register Überprüfen → Arbeitsmappe schützen → Struktur)
Dann kann niemand "versehentlich" die Reihenfolge der Blätter verändern.

Gruß Ralf

[Egon12]

@Ralf,
 
das ist natürlich der Beste Weg.
Indem man die Finger von den Modulnamen lässt (damit bleibt der Index erhalten), erspart man sich die Verrenkung dies mit einem zusätzlichen Array die Verweise aufs jeweilige korrekte Modul oder den passenden Blattnamen zu bauen.
 
Gruß Uwe

[Kuwer]

Hallo Uwe,

Indem man die Finger von den Modulnamen lässt (damit bleibt der Index erhalten), ...

das habe ich nicht verstanden. 

Gruß, Uwe

[Egon12]

Hallo Namenvetter,

stimmt der Index ist fix und ändert sich auch nicht, wenn der Name sich ändert.

Gruß Uwe