Option Explicit
Sub Ordnung()
Dim x As Integer
Dim y As Integer
Dim intx As Integer
Dim inty As Integer
Dim rngWert As Range
If Cells(3, 8).Value < 1 Then Exit Sub
On Error GoTo fail
intx = Cells(3, 8).Value + 6
If intx > Cells(Cells.Rows.Count, 7).End(xlUp).Row Then Exit Sub
For x = 7 To intx
Set rngWert = Cells(x, 8).Offset(-1)
Cells(x, 8).Value = Application.WorksheetFunction.VLookup(Cells(x, 7), _
Range(Cells(4, 1), Cells(Cells.Rows.Count, 2).End(xlUp)), 2, False)
Next x
inty = Cells(3, 8).Value + 6
If inty > Cells(Cells.Rows.Count, 7).End(xlUp).Row Then Exit Sub
For y = 7 To inty
Set rngWert = Cells(y, 9).Offset(-1)
Cells(y, 9).Value = Application.WorksheetFunction.VLookup(Cells(y, 7), _
Range(Cells(4, 4), Cells(Cells.Rows.Count, 5).End(xlUp)), 2, False)
Next y
On Error GoTo 0
fail:
Select Case Err.Number
Case 0
Case 1004
Select Case rngWert.Column
Case 8
Select Case rngWert.Row + 1
Case 7
If intx > 7 Then
x = x + 1
Resume
End If
Case 8 To intx
Cells(x, 8).Value = rngWert.Value
x = x + 1
Resume
End Select
Case 9
Select Case rngWert.Row + 1
Case 7
If inty > 7 Then
y = y + 1
Resume
End If
Case 8 To inty
Cells(y, 9).Value = rngWert.Value
y = y + 1
Resume
End Select
End Select
End Select
End Sub