Sub Zuanbaulist()
    Dim Rng As Range
    With Worksheets("Tabelle1")
        .Unprotect
        Set Rng = .Columns(1).Find(what:=Worksheets("Tabelle2").Range("A8"), lookat:=xlWhole, LookIn:=xlFormulas)
        If Rng Is Nothing Then
            Beep
            MsgBox "Eine Bearbeitung wurde nicht gefunden!", 64, "Infomeldung zur Bearbeitung"
        Else
            .Range("A1:P10000").AutoFilter Field:=1, Criteria1:=Worksheets("Tabelle2").Range("A8")
            .Range("I2:P10000").Copy    'nicht zu vergessen das hier alle eigenschaften einer zelle mitkopiert werden
        End If
    End With
    .Protect
End Sub  

Option Explicit
Sub Einfuegen()
    Dim Disa As Boolean, Scup As Boolean, Enec As Boolean
    Dim Calc As Integer
    Dim Lzeile As Long, DatNeuIndex As Long, ZeilenIndex As Long, SpaltenIndex As Long, SpalteIP As Long
    Dim SuchZelle As Double
    With Application
        Disa = .DisplayAlerts
        Scup = .ScreenUpdating
        Enec = .EnableEvents
        Calc = .Calculation
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    On Error GoTo EndeMakro
    Lzeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    ReDim SpalteAP(1 To Lzeile, 1 To 16) As Variant
    ReDim DatNeu(1 To Lzeile, 1 To 8) As Variant
    Worksheets("Tabelle1").Activate
    SpalteAP() = Range("A1:P" & Lzeile)
    SuchZelle = Worksheets("Tabelle1").Cells(1, 1).Value
    DatNeuIndex = 1
    For ZeilenIndex = 1 To Lzeile
        For SpaltenIndex = 1 To 16
            If SpalteAP(ZeilenIndex, SpaltenIndex) = SuchZelle Then
                For SpalteIP = 9 To 16
                    DatNeu(DatNeuIndex, SpalteIP - 8) = SpalteAP(ZeilenIndex, SpalteIP)
                Next SpalteIP
                DatNeuIndex = DatNeuIndex + 1
                Exit For
            End If
        Next SpaltenIndex
    Next ZeilenIndex
    Worksheets("Tabelle2").Activate
    Range(Cells(1, 1), Cells(Lzeile, 8)).Resize(UBound(DatNeu())) = DatNeu() 'position der gefilterten daten
EndeMakro:
    With Application
        .DisplayAlerts = Disa
        .ScreenUpdating = Scup
        .EnableEvents = Enec
        .Calculation = Calc
    End With
End Sub  

Sub Zuanbaulist()
    Dim Rng As Range
    With Worksheets("Tabelle1")
        .Unprotect
        Set Rng = .Columns(1).Find(what:=Worksheets("Tabelle2").Range("A8"), lookat:=xlWhole, LookIn:=xlFormulas)
        If Rng Is Nothing Then
            Beep
            MsgBox "Eine Bearbeitung wurde nicht gefunden!", 64, "Infomeldung zur Bearbeitung"
        Else
            .Range("A1:P10000").AutoFilter Field:=1, Criteria1:=CStr(Worksheets("Tabelle2").Range("A8"))
            .Range("I2:P10000").Copy    'nicht zu vergessen das hier alle eigenschaften einer zelle mitkopiert werden
        End If
    End With
    .Protect
End Sub