Macro per copiare valori tra due file MS Excel

L'esempio seguente permette di copiare tre valori presi da celle di un file Excel in un altro file Excel.
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