Consolidation of two Worksheets Execution Error - vba

Question

I am using the following code to consolidate two Worksheets (Sheet 5 and Sheet 3). More precisely, I am adding the data from Sheet 5 to Sheet 3 what is working smooth as long as have opened Sheet 3 when processing the code. However, when I switch to another sheet and run the code, the code doesn't work properly anymore.
When I run the code for the first time it works smooth
When I run the code repeatedly nothing should happen, because my macro just inserts data from Sheet 5 in Sheet 3that isn't already in Sheet 3 and since this data has already been inserted in the first run nothing should happen. This is the case, when I stay on Sheet 3. However, if I switch to another sheet and run the code a second, third, fourth time, then the macro is partly executed everytime.
Let me explain this a lil bit further:
For my tests I am using three rows with data. When I execute the button a first time, all three rows in Sheet 5 are added to Sheet 3. When I press the button a second, third, fourth time three rows are added to Sheet 3
First added row: Is empty
Second & Third added row: contain the data of the second and third row in Sheet 3
Does anyone have an idea what is going wrong here?
Sub Consolidation()
Dim lastrow As Long
Dim NFR As Long
lastrow = Tabelle5.Range("A" & Rows.Count).End(xlUp).Row
NFR = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(-3).Row
Set myrange = Tabelle5.UsedRange
For i = 4 To lastrow
On Error Resume Next
If Tabelle3.Cells(5 + i, 1) <> "" And Not IsError(Application.Match(Tabelle3.Cells(5 + i, 1), Tabelle5.Range("A:A"), False)) Then
Tabelle3.Cells(5 + i, 2) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(5 + i, 1), myrange, 2, False)
End If
If IsError(Application.Match(Tabelle5.Cells(i, 1), Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row), False)) Then
Tabelle3.Cells(NFR + i, 1) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 1, False)
Tabelle3.Cells(NFR + i, 2) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 2, False)
End If
Next i
Set Rng = Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row)
On Error Resume Next
Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Answer 1

Something like this (untested):
Sub Consolidation()
Dim lastrow As Long
Dim NFR As Long, r, v
lastrow = Tabelle5.Range("A" & Rows.Count).End(xlUp).Row
NFR = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(-3).Row
Set myrange = Tabelle5.UsedRange
For i = 4 To lastrow
v = Tabelle3.Cells(5 + i, 1)
If v <> "" And Not IsError(Application.Match(v, Tabelle5.Range("A:A"), False)) Then
r = Application.VLookup(v, myrange, 2, False)
Tabelle3.Cells(5 + i, 2) = IIf(IsError(r), "No match", r)
End If
v = Tabelle5.Cells(i, 1)
If IsError(Application.Match(v, Tabelle3.Range("A9:A" & _
Tabelle3.Range("A1048576").End(xlUp).Offset(8).Row), False)) Then
r = Application.VLookup(v, myrange, 1, False)
Tabelle3.Cells(NFR + i, 1) = IIf(IsError(r), "No match", r)
r = Application.VLookup(v, myrange, 2, False)
Tabelle3.Cells(NFR + i, 2) = IIf(IsError(r), "No match", r)
End If
Next i
Set Rng = Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row)
On Error Resume Next
Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub