|
Gut, ich habe B2 anstelle von B3 (so wie du es im ersten Beitrag geschrieben hast) verwendet.
Aber!
Kannst du den Code lesen und verstehen?
Es ist dach eien Leichtigkeit das im Code anzupassen.
Also in B1 der Pfad (sonst nix)
in B3 der Name ohne Endung
Die Endung ist im Code als ".pdf" eingetragen...
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
'*** Stammdaten Anfang
Set TB1 = Sheets("Tabelle1") 'aus bestimmtem Blatt
ZE = 7 'ab Zeile
'*** Stammdaten Ende
With TB1
Pfad = .Range("B1") & IIf(Right(.Range("B1"), 1) = "\", "", "\")
Datei = .Range("B3")
Ext = ".pdf"
LR = .Cells(.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
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
'*** Fehlerbehandlung
Err.Clear
Fehler:
If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub
|