Sub aktivesBlattToPdf()
Dim TB1, TB2
Set TB1 = ThisWorkbook.Sheets("Bestellung Firma")
Set TB2 = ThisWorkbook.Sheets("Anhang Firma")
ChDir "U:\Firma\"
ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, _
FileName:= Range("B26").Value & " " & Range("G16").Value & Format(Date, "-YYYY") & ".pdf", _
Quality:=x1QualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
LR = TB2.Cells(TB2.Rows.Count, "A").End(xlUp).Row + 1
TB1.Range("B26").Copy TB2.Range("A" & LR)
LR = TB2.Cells(TB2.Rows.Count, "C").End(xlUp).Row + 1
TB1.Range("G16:H16").Copy TB2.Range("C" & LR)
TB1.Range("G16") = TB1.Range("G16") + 1
End Sub