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
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Watch MrExcel Video

Forum statistics

Threads
1,114,539
Messages
5,548,631
Members
410,861
Latest member
Victor96
Top