|  
                                             Hallo an alle und dich mein Hoch geschätzter erster Antworter, 
ich habe für mich ein passendes script gefunden, es wirft zwar eine fehlermeldung aus, funktioniert aber. 
Sub KopierenUndUmbenennen1() 
Dim varData As Variant 
Dim LRow As Long, i As Long 
Dim strOld As String, strNew As String 
  
LRow = Cells(Rows.Count, 1).End(xlUp).Row 
varData = Range("A3:D" & LRow) 
For i = LBound(varData) To UBound(varData) 
   strOld = IIf(Right(varData(i, 1), 1) <> "\", varData(i, 1) & _ 
      "\", varData(i, 1)) & varData(i, 2) 
   strNew = IIf(Right(varData(i, 3), 1) <> "\", varData(i, 3) & _ 
      "\", varData(i, 3)) & varData(i, 4) 
   FileCopy strOld, strNew 
Next 
End Sub 
  
Sub KopierenUndUmbenennen2() 
Dim FSO As Object 
Dim varData As Variant 
Dim LRow As Long, i As Long 
Dim strOld As String, strNew As String 
  
Set FSO = CreateObject("Scripting.filesystemobject") 
LRow = Cells(Rows.Count, 1).End(xlUp).Row 
varData = Range("A3:D" & LRow) 
For i = LBound(varData) To UBound(varData) 
   strOld = IIf(Right(varData(i, 1), 1) <> "\", varData(i, 1) & _ 
      "\", varData(i, 1)) & varData(i, 2) 
   strNew = IIf(Right(varData(i, 3), 1) <> "\", varData(i, 3) & _ 
      "\", varData(i, 3)) & varData(i, 4) 
   FSO.copyFile strOld, strNew 
Next 
End Sub 
  
Excel VBA: Dateien kopieren und an anderem Ort ablegen - Microsoft Community 
Liebe Grüße  
Leo 
  
     |