Sub TestFind()
Dim arrNewData() As Variant, x As Long, z As Long
Dim newData As Range, fndData As Range, c As Range
With Sheets("Tabelle1")
Set newData = .Range(.Cells(4, 3), .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 8)
arrNewData = newData.Value
newData.ClearContents
For x = LBound(arrNewData, 1) To UBound(arrNewData, 1)
Set fndData = .Columns(1).Find(What:=arrNewData(x, 1), LookIn:=xlFormulas)
If Not fndData Is Nothing Then
Set fndData = fndData.Offset(, 2).Resize(, 8)
For z = LBound(arrNewData, 2) To UBound(arrNewData, 2)
fndData.Cells(z) = arrNewData(x, z)
Next z
End If
Next x
End With
End Sub
Achtung - Bereich $C$4:$J$... wird gelöscht und neu verteilt
|