Sub PDF_ablegen()
On Error GoTo Fehler
Const APPNAME = "PDF_ablegen"
Dim TB1 As Worksheet, i As Integer
Dim ZE As Integer, LR As Integer
Dim Pfad As String, Datei As String, Ext As String, NewName As String
Set TB1 = Sheets("Tabelle1")
ZE = 7
With TB1
Pfad = .Range("B1") & IIf(Right(.Range("B1"), 1) = "\", "", "\")
Datei = <strong>.Range("B3")</strong>
Ext = ".pdf"
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
If Dir(Pfad & Datei & Ext) <> "" Then
For i = ZE To LR
FileCopy Pfad & Datei & Ext, Pfad & .Cells(i, 1) & "_" & .Cells(i, 2) & Ext
Next
Else
MsgBox "PDF / Verzeichnis nicht vorhanden"
End If
End With
Err.Clear
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub