Sub
Route()
Dim
TB1
As
Worksheet, TB2
As
Worksheet
Dim
ZE
As
Integer
, LR
As
Long
On
Error
GoTo
Fehler
Const
APPNAME =
"Route"
Application.ScreenUpdating =
False
Set
TB1 = Sheets(
"Blatt A"
)
Set
TB2 = Sheets(
"Blatt B"
)
ZE = 2
With
TB1
LR = .Cells(.Rows.Count, 1).
End
(xlUp).Row
With
.Cells(ZE, 1).Offset(0, 1).Resize(LR - 1, 1)
.FormulaR1C1 =
"=IFERROR(VLOOKUP(RC1,'Blatt B'!C1:C2,2,0),"
""
")"
'Formel Sverweis eintragen
.Value = .Value
End
With
End
With
Err.Clear
Fehler:
If
Err.Number <> 0
Then
MsgBox
"Fehler in Sub "
""
& APPNAME &
""
""
& vbCrLf _
&
"Fehlernummer: "
& Err.Number & vbLf & Err.Description: Err.Clear
End
Sub