|
Als Ereignis - ins Klassenmodul Tabelle1
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 And _
UCase(Target.Value) = "X" And _
Not Intersect(Columns("E"), Target) Is Nothing Then
With Sheets("Tabelle2").Columns(1)
.Cells(.Cells.Count).End(xlUp).Offset(1).Value = Target.Offset(, -4)
.RemoveDuplicates Columns:=1, Header:=xlNo
End With
End If
End Sub
oder alternativ als Trivial - Makro (Modul) für die Massenanalyse
Sub NameCopyX()
'In Tabelle1 sind in Spalte A Namen aufgezählt.
Dim x As Long
Dim arrX() As Variant
'Bei einigen Namen steht in derselben Zeile in Spalte E ein x
With Sheets("Tabelle1").Columns(1)
arrX = .Range(.Cells(1), .Cells(.Cells.Count).End(xlUp)).Offset(, 4).Value
End With
'Die werte, die mit einem X in Spalte E gekennzeichnet sind
With Sheets("Tabelle2").Columns(1)
For x = LBound(arrX, 1) To UBound(arrX, 1)
If UCase(arrX(x, 1)) = "X" Then
'in die erste leere Zeile in Tabelle 2 Spalte A übertragen
.Cells(.Cells.Count).End(xlUp).Offset(1).Value = _
Sheets("Tabelle1").Rows(x).Cells(1)
End If
Next x
.RemoveDuplicates Columns:=1, Header:=xlNo
End With
End Sub
|