Daten kopieren, wenn Bedingung erfüllt ist!

[Weihenstephan]

Hallo!

Mein Ziel ist es, wenn die Bedingung erfüllt ist, mehrere Werte von verschiedenen Reitern/Seiten in den andren Reiter/Seite zu kopieren.

Ich habe eine Beispiel Datei mitgeschickt.
Erklärung: Das Ziel wäre durch ein "x" in Seite1/Spalte F, die Werte aus der Spalte A B D und E auf die Seite 2 in die Tabelle (Rechts daneben ist ein BSP) zu kopieren.
Außerdem und das ist das wichtigste: Ich muss diesen Vorgang öfters machen also sollte das in einer Art Liste da stehen, sprich beim nächsten "Kopiervorgang" sollte dieser darunter eingefügt werden.

Danke für eure Hilfe!
Ich hoffe ihr versteht was ich meine!

LG T

[Niclaus]

Hallo
Schau mal in die angehängte Datei - mit Makros!
Wenn Du in Seite1/Spalte F ein x eingibst, wird die entsprechende Zeile als neue Zeile in Seite2 eingefügt.
Grüsse Niclaus

Das erste Makro - einfügen unter MS Excel Objekte / Tabelle1

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo finis
Set Target = Intersect(Target, Columns("F:F"))
If Target Is Nothing Then Exit Sub

If Target.CountLarge > 1 Then
    MsgBox "Nur eine Zelle markieren!"
    Exit Sub
End If

Target(1, 1).Select
If Target = "x" Then
    tz = Target.Row
    kopieren (tz)
End If
Target(2, 1).Select
finis:

End Sub

Das zweite Makro - einfügen in ein Modul

Code:

Sub kopieren(tz)
With Sheets("Seite 1")
    Union(.Cells(tz, 1), .Cells(tz, 2), .Cells(tz, 4), .Cells(tz, 5)).Copy
End With
With Sheets("Seite 2")
    lz2 = .Cells(Rows.Count, 1).End(xlUp).Row    ' letzte Zeile in Sp. A
    .Cells(lz2 + 1, 1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
End With
Sheets("Seite 2").Select
    Cells(lz2 + 1, 1).Select
End Sub

  bsp_v1.xlsm (Größe: 18,86 KB / Downloads: 6)