Range("B:B").Clear<BR>lRow = Cells(Rows.count, 1).End(xlUp).Row<BR>For Each rng In Range("B1:B" & lRow).Cells<BR> rng = WorksheetFunction.VLookup(CStr(rng.Offset(0, -1)), Worksheets("Ressourcen").Range("A:D"), 2)<BR>Next rng
Sub tiere()
Dim rng As Range
Dim rng1 As Range
Dim tier As Variant
Dim tierArt As Variant
Dim art As Long
art = 1
For Each rng In Sheets("Tiere").UsedRange.Range("AA2")
tier = rng.Value
If Not IsEmpty(tier) Then
For Each rng1 In Sheets("Deklaration").UsedRange.Column(1)
If tier = rng1.Value Then
tierArt = rng1.Offset(0, 1).Value
Sheets("Tiere").Cells(art, 2).Value = tierArt
art = art + 1
End If
Next rng1
For Each rng1 In Sheets("Deklaration").UsedRange.Column(3)
If tier = rng1.Value Then
tierArt = rng1.Offset(0, 1).Value
Sheets("Tiere").Cells(art, 2).Value = tierArt
art = art + 1
End If
Next rng1
End If
End Sub