hi andreas ^^
etwas in der art ?
gruss nighty
Sub DatAkt()
Worksheets("M-Nr").Select
Dim rng As Range, rng1 As Range
Dim iRow As Integer, iRow2 As Integer
Dim icolum1 As Long, icolum2 As Long
iRow = 2
iRow2 = 2
icolum1 = Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
icolum2 = Worksheets("Daten").Cells(Rows.Count, 2).End(xlUp).Row
Do Until IsEmpty(Cells(iRow, 1))
Set rng = Worksheets("Daten").Range(Cells(iRow2, 1), Cells(icolum1, 1)).Find( _
what:=Cells(iRow, 3), lookat:=xlWhole, LookIn:=xlValues)
Set rng1 = Worksheets("Daten").Range(Cells(iRow2, 2), Cells(icolum2, 2)).Find( _
what:=Cells(iRow, 4), lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing And Not rng1 Is Nothing And rng.Row = rng1.Row Then
Range(rng.Offset(0, 4), rng.Offset(0, 4)).Value = _
Cells(iRow, 1).Value
iRow2 = rng.Row + 1
Else
iRow = iRow + 1
iRow2 = 2
End If
Sheets("M-Nr").Select
Loop
End Sub
p.s.
nicht getestet ^^