Private Sub workbook_open()
Application.Visible = False

Dim wb As Workbook
Set wb = ActiveWorkbook

Call Copy_FilesImport

Application.Visible = True
Application.Quit
Application.ActiveWindow.Close savechanges:=True
ActiveWorkbook.Close savechanges:=True
End Sub
Private Sub Copy_FilesImport()
Dim fso1 As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String

FromPath = "I:Path1"
ToPath = "I:Path2"

Dim FilName As String
FilName = "FileA.xlsx"

If Right(FromPath, 1) <> "" Then
    FromPath = FromPath & ""
End If

Set fso1 = CreateObject("scripting.filesystemobject")

If fso1.FolderExists(FromPath) = False Then
    MsgBox FromPath & "Error message"
    Exit Sub
End If

If fso1.FolderExists(ToPath) = False Then
    MsgBox ToPath & "Error message"
    Exit Sub
End If

fso1.copyFile Source:=FromPath & FilName, Destination:=ToPath
Call Renamefiles1
End Sub

Private Sub Renamefiles1()

Dim sName As String
Dim fso As Object
Dim fol As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder("I:Path2")

For Each Fil In fol.Files
If InStr(1, Fil.Name, "FileA.xlsx") <> 0 Then
sName = Replace(Fil.Name, "FileA", "FileD")
Fil.Name = sName
End If
Next

Call Value

End Sub

Private Sub Value()
Workbooks.Open Filename:=("I:Path2FileD.xlsx")
Dim file As String
file = "FileD.xlsx"
For i = 1 To Workbooks(sName).Worksheets.Count

Sheets(i).Select

Range("A1").Select
Sheets(i).Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Next i
Workbooks("FileD.xlsx").Close savechanges:=True

Call Renamefiles2

End Sub



Private Sub Renamefiles2()

Dim sName As String
Dim fso As Object
Dim fol As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder("I:Path2")

Dim datoformat As String
datoformat = Format(Date, "yyyy-mm-dd")


For Each Fil In fol.Files
If InStr(1, Fil.Name, "FileD.xlsx") <> 0 Then
sName = Replace(Fil.Name, "FileD", "FileD_" & datoformat)
Fil.Name = sName
End If
Next
MsgBox "Succes"
End Sub