Automatisches Kopieren in andere Arbeitsblätter des gleichen Dokuments unter Bedingungen

Question

Hallo zusammen,
Ich möchte eine Übersicht erstellen um Prozesse leichter zu gestalten. Dazu möchte ich, dass Daten, die in einer Übersichtstabelle eingetragen werden automatisch in andere Blätter kopiert werden, je nach dem, welcher Text in einer speziellen Spalte eingegeben ist (4 mögliche Werte).
Kann man das Problem mit Excel lösen? Ich habe leider keine Möglichkeit mit Access zu arbeiten, da wüsste ich die Lösung meines Problems :-(

Danke schon mal!!

Answer 1

hi all ^^

ein Beispiel

einzufuegen alt+f11/projektexplorer/TabelleÜbersicht

gruss nighty

spalte a wird abgefargt
spalte a bis e von der aktuellen zeile des stichwortes kopiert
namen der Stichwörter und worksheetnamen sind leicht ergaenzbar

Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 Then
Dim Stichwort As Variant, TabellenN As Variant
Dim TabName As Integer
Dim Lzeile As Long
Stichwort = Array("Rot", "Gruen", "Blau")
TabellenN = Array("Tabelle1", "Tabelle2", "Tabelle3")
For TabName = 1 To UBound(Stichwort)
If Target = Stichwort(TabName) Then
Lzeile = Worksheets(TabellenN(TabName)).Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Übersicht").Range("A" & Target.Row & ":E" & Target.Row).Copy Worksheets(TabellenN(TabName)).Range("A" & Lzeile & ":E" & Lzeile)
End If
Next TabName
End If
Application.EnableEvents = True
End Sub

Answer 2

hi all ^^

noch ein wenig optimiert

gruss nighty

Private Sub worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 Then
Dim Stichwort As Variant, TabellenN As Variant
Dim TabName As Integer, ArrAnz As Integer
Dim Lzeile As Long
Stichwort = Array("Rot", "Gruen", "Blau")
TabellenN = Array("Tabelle1", "Tabelle2", "Tabelle3")
ArrAnz = UBound(Stichwort)
For TabName = 1 To ArrAnz
If UCase(Target) = UCase(Stichwort(TabName)) Then
Lzeile = Worksheets(TabellenN(TabName)).Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Übersicht").Range("A" & Target.Row & ":E" & Target.Row).Copy Worksheets(TabellenN(TabName)).Range("A" & Lzeile & ":E" & Lzeile)
Exit For
End If
Next TabName
End If
Application.EnableEvents = True
End Sub

Answer 3

Danke!