Import range from from excel files in a folder and save as based on a cell value

Doraenobi

New Member
Joined
Aug 2, 2020
Messages
1
Office Version
  1. 365
Platform
  1. Windows
Hello everyone,
I have a few excel (.xlsm) files in a folder made for each experiment (PhD student) based on an older version master template excel file. Now that I have updated the master template to include further analysis, I would like to have all the previous experimental data to be re-analysed by this template.

So what I am trying to achieve is this:
For each excel files in FolderA, copy range B2:D100 from worksheet SheetTwo and paste into range B2:D100 of SheetTwo of NewTemplate.xlsm file before saving it as a value from cell E1 in SheetTwo.
Then repeat for the next file in FolderA.

I would like to have the files in FolderA and the NewTemplate to remain unchanged at the end of the process.

I have stitched together few lines of code from various sources but stuck at achieving the above.
Here is a base code that I tried:

VBA Code:
Sub RunOnAllFilesInFolder()

Dim folderName As String
Dim eApp As Excel.Application
Dim fileName As String

Dim wb As Workbook
Dim ws As Worksheet
Dim currWs As Worksheet
Dim currWb As Workbook

Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet
 
    'Select folder in which all files are stored
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.path
    If fDialog.Show = -1 Then
      folderName = fDialog.SelectedItems(1)
    End If
    
    
    'Create a separate Excel process that is invisibile
    Set eApp = New Excel.Application:  eApp.Visible = False
    
    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    fileName = Dir(folderName & "\*.xlsm")
    Do While fileName <> ""
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & folderName & "\" & fileName
 
 
        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
'--------------------Code to run starts----------------------------------------------------

'copy from old file to NewTemplate then SaveAsFilenameE1 the NewTemplate to cell value E1, obviously the code below is wrong'

wb.Worksheets("SheetTwo").Range("B2:D100").Copy
   currWb.Worksheets("SheetTwo").Range ("B2")
Call SaveAsFilenameE1 

'---------------------Code to run ends----------------------------------------------------

        wb.Close SaveChanges:=False 'Close opened workbook w/o saving, change as needed
        
        Debug.Print "Processed " & folderName & "\" & fileName
        fileName = Dir()
    Loop
    eApp.Quit
    Set eApp = Nothing

    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"

End Sub

Sub SaveAsFilenameE1()

Dim fname As String
Dim path As String

fname = Range("E1").Value
path = Application.ActiveWorkbook.path

Application.ActiveWorkbook.SaveAs fileName:=path & "\" & fname, _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
End Sub

I would really appreciate any help in surmounting this trouble. ?Merci d'avance
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top