In questo caso da file "example.xlsx" a "new_file_yyyy-mm-dd_hh-mm_ss.xlsx"
Il codice è stato inserito su di un pulsante presente in un file "example.xlsm" (file di tipo MS Excel 2007 che permette di editare ed eseguire macro).
File example.xlsm
Option Explicit Sub cmdCreateOuput_Click() Dim currentPath As String Dim strId, strName, nameFileOut, nameFileIn As String Dim extNameFileOut As String Dim myArrayId() As String Dim FileFormatNum As Integer Dim i As Integer Dim Sourcewb Dim Destwb Dim myArrayName() As String ReDim myArrayId(3) ReDim myArrayName(3) currentPath = ThisWorkbook.Path nameFileIn = "example.xlsx" '----- start file input ----- Set Sourcewb = Workbooks Application.DisplayAlerts = False Application.ScreenUpdating = False Sourcewb.Open currentPath & "\" & nameFileIn, ReadOnly:=True With Sourcewb(2) .Activate .Sheets(1).Protect UserInterfaceOnly:=True strId = .Sheets(1).[A14] strName = .Sheets(1).[B14] For i = 1 To 3 myArrayId(i) = .Sheets(1).Cells(i + 14, "A").Value myArrayName(i) = .Sheets(1).Cells(i + 14, "B").Value Next i .Close SaveChanges:=False End With '----- end file input ----- '----- start file output ----- Set Destwb = Workbooks.Add extNameFileOut = ".xlsx": FileFormatNum = 51 nameFileOut = "new_file_" & Format(Now, "yyyy-mm-dd_hh-mm_ss") With Destwb .Sheets(1).[A1] = strId .Sheets(1).[B1] = strName For i = 1 To UBound(myArrayId) .Sheets(1).Cells(i + 1, "A") = myArrayId(i) .Sheets(1).Cells(i + 1, "B") = myArrayName(i) Next .SaveAs currentPath & "\" & nameFileOut & extNameFileOut, FileFormat:=FileFormatNum .Close SaveChanges:=True End With '----- end file output ----- MsgBox "File created." End Sub