EXCEL VBA - Transferring data from multiple workbooks to workbook template

Question

I'm trying to make an excel ui/macros which allows the user to select multiple excel workbooks(wb1,wb2,wb3...) and transfer certain values from them to another workbook(wb_template). Afterwards, saving each one of them as new workbooks (wb1_new,wb2_new,wb3_new...).

Meaning: The template workbook can be used over and over again, and is being saved as a new workbook every time - should be named after the original workbook(wb1) + "_new"):

>     Wb1 + wb_template = wb1_new
>     Wb2 + wb_template = wb2_new
>     Wb3 + wb_template = wb3_new

To summarize the scenario:

Selection of multiple workbooks via dialog box
Displaying the selection in a list box
Transferring certain values from those workbooks into a workbook template
Saving the workbook template as a new workbook for each excel workbook from the list box
Result: a couple of new excel workbooks, named after the original excel workbooks from the list box

How can I achieve something like this? Here is a screenshot of the current UI: https://imgur.com/a/ynnhbm0

I have this code for the data transfer:

Sub Button1_Click()


Dim wb1 As Workbook
Dim wb_template As Workbook

Set wb1 = Application.Workbooks.Open("C:\Users\PlutoX\Desktop\Folder\wb1")
Set wb_template = Application.Workbooks.Open("C:\Users\PlutoX\Desktop\Folder\wb_template")


wb_template.Sheets("Sheet1").Range("A1").Value = wb1.Sheets("Sheet1").Range("A1").Value
wb_template.Sheets("Sheet1").Range("A2").Value = wb1.Sheets("Sheet1").Range("A2").Value
wb_template.Sheets("Sheet1").Range("A3").Value = wb1.Sheets("Sheet1").Range("A3").Value



wb1.Close False
wb_template.Close True


End Sub

Problems:

Origin files(wb1) are static. Need a variable that refers to the selected files from the list box - adding the filepaths of the selected files to the code

I have this code for the dialog window/selection of files:

Sub openDialog()
    Dim fd As Office.FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

   With fd

      .AllowMultiSelect = True

      ' Set the title of the dialog box.
      .Title = "Please select the file."

      ' Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "Excel 2003", "*.xls"
      .Filters.Add "All Files", "*.*"

      ' Show the dialog box. If the .Show method returns True, the
      ' user picked at least one file. If the .Show method returns
      ' False, the user clicked Cancel.
      If .Show = True Then
        txtFileName = .SelectedItems(1) 'replace txtFileName with your textbox

      End If
   End With
End Sub

Problems:

How do I display the file names in the list box? Can't figure it out...
How do I make sure that the filepaths are handed over to the variable from the "data transfer" code?

Would be very grateful for some help!

L42 L42 · Accepted Answer · 2018-08-10T08:24:55

For the first, I'd say abandon the FileDialog and use Excels built-in method. Something like:

Private Sub CommandButton1_Click()
    Dim fNames As Variant
    With Me
        fNames = Application.GetOpenFilename("Excel File(s) (*.xls*),*.xls*", , , , True)
        If IsArray(fNames) Then .ListBox1.List = fNames
    End With
End Sub

Above goes to your BrowseFile (from screen shot) button.
For the Transfer File button, you need to iterate to the ListBox items.
But before that, you need to make your file transferring Sub generic. Something like:

Sub Transferfile(wbTempPath As String, wbTargetPath As String)

    Dim wb1 As Workbook
    Dim wb_template As Workbook

    Set wb1 = Workbooks.Open(wbTargetPath)
    Set wb_template = Workbooks.Open(wbTempPath)

    '/* I believe this should be dynamic but that is another story */
    wb_template.Sheets("Sheet1").Range("A1").Value = wb1.Sheets("Sheet1").Range("A1").Value
    wb_template.Sheets("Sheet1").Range("A2").Value = wb1.Sheets("Sheet1").Range("A2").Value
    wb_template.Sheets("Sheet1").Range("A3").Value = wb1.Sheets("Sheet1").Range("A3").Value

    wb1.Close False
    wb_template.Close True

End Sub

Above is a Sub procedure taking on 2 arguments.
Now, the remaining part is the code for the Transfer File button which should look like something:

Private Sub CommandButton2_Click()    
    Dim i As Integer
    '/* I assumed it is fixed, note that you need the full path */
    Const mytemplate As String = "C:\Users\PlutoX\Desktop\Folder\wb_template.xlsx"
    With Me
        With .ListBox1
            '/* iterate listbox items */
            For i = 0 To .ListCount - 1
                '/* transfer the files using your generic procedure */
                Transferfile mytemplate, .List(i, 0)
            Next
        End With
    End With    
End Sub

EXCEL VBA - Transferring data from multiple workbooks to workbook template

1 Answers