Bei Set wsbol = Tabelle5. Diese Tabelle gibt es nicht, daher ist die Fehlermeldung "korrekt". Meine Frage ist, warum ich diese Fehlermeldung nicht erhalte, wenn das Sub gecalled wird.

Hier das Sub. Danke im Voraus :)

Sub bolanalysis()
'In old + new nach Nullern filtern und spalte f+g kopieren un din bolanalysis einfügen

'!!!! Es muss sichergestellt werden, dass in den anderen Arbeitsblättern in BOL Analysis auch die passenden Überschriften existieren



Dim ws As Worksheet
Set ws = Tabelle1
Dim wsnew As Worksheet
Set wsnew = Tabelle2
Dim wsbol As Worksheet
Set wsbol = Tabelle5

Dim testrange As Range

Dim lrow As Integer
Dim Oldcell As Range

Dim arrCriteria() As String
Dim lngCriteriaCount As Long
Dim element As Variant

Dim arrCriterianew() As String
Dim lngCriterianewCount As Long


Dim lrownew As Integer
Dim NewCell As Range

'Löscht die alten Zeilen in Tabelle5

lngCriteriaCount = 3

ReDim arrCriteria(0 To lngCriteriaCount - 1)
arrCriteria(0) = "Royalities_old"
arrCriteria(1) = "Part#_old"
arrCriteria(2) = "Description_old"

lngCriterianewCount = 3

ReDim arrCriterianew(0 To lngCriterianewCount - 1) ' Hier wäre auch mal die fra
arrCriterianew(0) = "Royalities_new"
arrCriterianew(1) = "Part#_new"
arrCriterianew(2) = "Description_new"

lrow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
lrownew = wsnew.UsedRange.SpecialCells(xlCellTypeLastCell).Row
lrowbol = wsbol.UsedRange.SpecialCells(xlCellTypeLastCell).Row
lcolbol = wsbol.UsedRange.SpecialCells(xlCellTypeLastCell).Column


'wsbol.Range(wsbol.Cells(4, 1), wsbol.Cells(lrowbol, lcolbol)).Delete Shift:=xlUp

Tabelle5.UsedRange.ClearContents
Tabelle5.UsedRange.ClearFormats

wsbol.Range("A1") = "Part#_old"
wsbol.Range("B1") = "Description_old"
wsbol.Range("C1") = "Royalities_old"

wsbol.Range("E1") = "Part#_new"
wsbol.Range("F1") = "Description_new"
wsbol.Range("G1") = "Royalities_new"


Errorhandler:



On Error GoTo Errorhandler1
Tabelle2.Cells.Replace What:="Part#_new", Replacement:="Part#", SearchOrder:=xlByColumns, MatchCase:=True
Tabelle2.Cells.Replace What:="Description_new", Replacement:="Description", SearchOrder:=xlByColumns, MatchCase:=True
Tabelle2.Cells.Replace What:="Royalities_new", Replacement:="Royalities", SearchOrder:=xlByColumns, MatchCase:=True

Tabelle1.Cells.Replace What:="Part#_old", Replacement:="Part#", SearchOrder:=xlByColumns, MatchCase:=True
Tabelle1.Cells.Replace What:="Description_old", Replacement:="Description", SearchOrder:=xlByColumns, MatchCase:=True
Tabelle1.Cells.Replace What:="Royalities_old", Replacement:="Royalities", SearchOrder:=xlByColumns, MatchCase:=True

Errorhandler1:

Tabelle1.Cells.Replace What:="Part#", Replacement:="Part#_old", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole
Tabelle1.Cells.Replace What:="Description", Replacement:="Description_old", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole
Tabelle1.Cells.Replace What:="Royalities", Replacement:="Royalities_old", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole

Tabelle2.Cells.Replace What:="Part#", Replacement:="Part#_new", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole
Tabelle2.Cells.Replace What:="Description", Replacement:="Description_new", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole
Tabelle2.Cells.Replace What:="Royalities", Replacement:="Royalities_new", SearchOrder:=xlByColumns, MatchCase:=True, LookAt:=xlWhole

If ws.AutoFilterMode = False Then
ws.Rows(2).AutoFilter
End If

If wsnew.AutoFilterMode = False Then
wsnew.Rows(2).AutoFilter
End If

'Da steht quasi: Wenn der wert in zeile 2 (in Abhängigkeit von i) = eines der Elemente von oben
' dann --> wenn das element auch gleich einem wert in wsbol is in zeile 3 (in abhängigkeit von j)
' dann

For i = 1 To 30
    If ws.Cells(2, i).Value = "Royalities_old" Then
    ws.Range(ws.Cells(2, i), ws.Cells(lrow, i)).AutoFilter Field:=i, Criteria1:="<>0"
    End If
Next

For i = 1 To 30
    For j = 1 To 10
        For Each element In arrCriteria()
            If element = ws.Cells(2, i).Value Then  'Royalties wurden falsch geschrieben
                If element = wsbol.Cells(1, j).Value Then
                    Set testrange = ws.Range(ws.Cells(3, i), ws.Cells(lrow, i))
                   testrange.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeVisible).Copy wsbol.Cells(lrowbol + 1, j) 'Pasten noch machen wsbol.einsunterroyalties (Range("G4") G = j 4 lastrow mit offset von j
                    
                End If
            End If
        Next
    Next
Next



For i = 1 To 30
    If wsnew.Cells(2, i).Value = "Royalities_new" Then
    wsnew.Range(wsnew.Cells(2, i), wsnew.Cells(lrownew, i)).AutoFilter Field:=i, Criteria1:="<>0"
    End If
Next

For i = 1 To 30
    For j = 1 To 10
        For Each element In arrCriterianew()
            If element = wsnew.Cells(2, i).Value Then  'Royalties wurden falsch geschrieben
                If element = wsbol.Cells(1, j).Value Then
                    wsnew.Range(wsnew.Cells(3, i), wsnew.Cells(lrownew, i)).SpecialCells(xlCellTypeVisible).Copy wsbol.Cells(lrowbol + 1, j) 'Pasten noch machen wsbol.einsunterroyalties (Range("G4") G = j 4 lastrow mit offset von j
                    
                End If
            End If
        Next
    Next
Next


wsbol.Range("I1").FormulaLocal = "=SUMME(H3:H20)"

End Sub