über Name definierten Bereich kopieren

Hallo zusammen,
in der angehangenen Tabelle gibt es 2 Sheets.
Einmal ein Sheet (Matrix) als Vorlage/Liste und des weiteren ein Sheet (Arbeitsblatt C2) welches ausgefüllt werden soll.
Wenn ich in Arbeitsblatt C2 in Spalte A10-Axx ein Wert eintrage (1.1 oder 10.1) dann soll aus der Vorlage (Matrix) der daneben stehende Text bzw. die Zeilen+Spalten kopiert und in Arbeitsblatt C2 eingefügt werden.
Dadurch das die einzelnen Punkte 1.1, 1.2 ect. unterschiedlich viele Zeilen besitzen, habe ich in der Vorlage die Bereiche markiert und einen Namen vergeben.
Es sollen dann auch mehrere Punkte in Arbeitblatt C2 eingefügt werden können, jenachdem was man in Spalte A einträgt.
Ist das eher mit VBA oder mit SVERWEIS zu lösen.
Vielen Dank schon einmal
Bart
https://www.herber.de/bbs/user/157386.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Bart,
ein Versuch:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Z As Range
Dim T2 As Range
    If Target.Cells.Count > 1 Then Exit Sub 'nur wenn nur eine Zelle geändert wurde.
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Set Z = Worksheets("Matrix").Range("A:A").Find(what:=Target.Value)
        If Not Z Is Nothing Then
            Application.EnableEvents = False
            Set T2 = Target.Offset(-1) 'damit wir die Zelle direkt über die Eingabe "gemerkt"
            If Target.End(xlDown).Value = "Daten für Auswahlliste" Then
                Range(Target, Range("F99999").End(xlUp)).EntireRow.Delete 'aktuellen Bereich löschen, im Fall "letzter"
            Else
                Range(Target, Target.End(xlDown).Offset(-1)).EntireRow.Delete 'aktuellen Bereich löschen, in anderne Fälle
            End If 
            Z.Parent.Range(Z, Z.End(xlDown).Offset(-1)).EntireRow.Copy 'Kopieren
            T2.Offset(1).Insert Shift:=xlDown 'als neue Zeilen einführen
            With Range(T2.Offset(1), T2.Offset(1).End(xlDown).Offset(-1)).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & Range(Range("A99999").End(xlUp), Range("A99999").End(xlUp).End(xlUp)).Address 'Auswahlliste erneuern
            End With
            T2.Offset(1).Select
            Application.EnableEvents = True
        End If
    End If
End Sub

In Matrix!A235 muss irgendwas in der Zelle sein. Sonst geht die Kopie beim Fall 11.4 bis Zeile 1048576 !
VG
Yal

Beliebteste Forumthreads (12 Monate)

über Name definierten Bereich kopieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread