Hallo Ihr Experten,
Kann mir jemand den Code (läuft OK) nur vereinfachen/kürzen?
Es wird eine pdf-Datei erzeugt und gleichzeitig je nach 2 Abfragen auf unterschiedliche Bereiche Werte kopiert.

Sub aktivesBlattToPdf()
Dim Quelle As Worksheet
Dim Ziel As Worksheet

Set Quelle = Sheets("PRÄ")
Set Ziel = Sheets("STATISTIK")

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "" & Quelle.Name & "." & Quelle.Range("D3").Value & "." & Format(Date, "YY.") & Range("E2") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

Ziel.Unprotect Password:="pass"

With Ziel
Quelle.Range("P8:P107").Copy
    Select Case Quelle.Range("E2").Value And Quelle.Range("D3") = Tabelle15.Name
        Case 1:
            .Range("C4").PasteSpecial Paste:=xlValues
        Case 2:
            .Range("D4").PasteSpecial Paste:=xlValues
        Case 3:
            .Range("E4").PasteSpecial Paste:=xlValues
        Case 4:
            .Range("F4").PasteSpecial Paste:=xlValues
        Case 5:
            .Range("G4").PasteSpecial Paste:=xlValues
        Case 6:
            .Range("H4").PasteSpecial Paste:=xlValues
        Case 7:
            .Range("I4").PasteSpecial Paste:=xlValues
        Case 8:
            .Range("J4").PasteSpecial Paste:=xlValues
        Case 9:
            .Range("K4").PasteSpecial Paste:=xlValues
        Case 10:
            .Range("L4").PasteSpecial Paste:=xlValues
        Case 11:
            .Range("M4").PasteSpecial Paste:=xlValues
        Case 12:
            .Range("N4").PasteSpecial Paste:=xlValues
    End Select
End With

With Ziel
Quelle.Range("P8:P107").Copy
    Select Case Quelle.Range("E2").Value And ActiveSheet.Range("D3") = Tabelle16.Name
        Case 1:
            .Range("S4").PasteSpecial Paste:=xlValues
        Case 2:
            .Range("T4").PasteSpecial Paste:=xlValues
        Case 3:
            .Range("U4").PasteSpecial Paste:=xlValues
        Case 4:
            .Range("V4").PasteSpecial Paste:=xlValues
        Case 5:
            .Range("W4").PasteSpecial Paste:=xlValues
        Case 6:
            .Range("X4").PasteSpecial Paste:=xlValues
        Case 7:
            .Range("Y4").PasteSpecial Paste:=xlValues
        Case 8:
            .Range("Z4").PasteSpecial Paste:=xlValues
        Case 9:
            .Range("AA4").PasteSpecial Paste:=xlValues
        Case 10:
            .Range("AB4").PasteSpecial Paste:=xlValues
        Case 11:
            .Range("AC4").PasteSpecial Paste:=xlValues
        Case 12:
            .Range("AD4").PasteSpecial Paste:=xlValues
    End Select
End With

With Ziel
Quelle.Range("P8:P107").Copy
    Select Case Quelle.Range("E2").Value And ActiveSheet.Range("D3") = Tabelle17.Name
        Case 1:
            .Range("AI4").PasteSpecial Paste:=xlValues
        Case 2:
            .Range("AJ4").PasteSpecial Paste:=xlValues
        Case 3:
            .Range("AK4").PasteSpecial Paste:=xlValues
        Case 4:
            .Range("AL4").PasteSpecial Paste:=xlValues
        Case 5:
            .Range("AM4").PasteSpecial Paste:=xlValues
        Case 6:
            .Range("AN4").PasteSpecial Paste:=xlValues
        Case 7:
            .Range("AO4").PasteSpecial Paste:=xlValues
        Case 8:
            .Range("AP4").PasteSpecial Paste:=xlValues
        Case 9:
            .Range("AQ4").PasteSpecial Paste:=xlValues
        Case 10:
            .Range("AR4").PasteSpecial Paste:=xlValues
        Case 11:
            .Range("AS4").PasteSpecial Paste:=xlValues
        Case 12:
            .Range("AT4").PaseSpecial Paste:=xlValues
    End Select
End With

        Ziel.protect Password:="pass"
        Worksheets("PRÄ").Select
        Range("C2").Select

End Sub