Automate summary sheet fill in from multiple report files VBA

[Neox]

Hi everyone,
I am still very much a beginner at VBA, but I have learned a lot from reading this forum and I hope that you might help me with my issue or at least point me in the right direction as I am a bit stuck at the moment.

My goal is to automate the following task:

I have a Summary File with one sheet that looks like this:

I also have a lot of report files (100+). All of them are the same, the only thing that changes are the numbers. The report file has two sheets. Sheet 1(example in bottom picture) is the main report and sheet2 is the background data. The numbers in sheet1 are formulas linking to sheet2.

What I am trying to do is automate the inputting of data. So I would like to select all the report files and populate the summary file with the data. So, for example, I would put C10 from the report file into Column_3 in the summary file and repeat that for all the 100+ files.

----------------------------------

My first thought was bringing all the report sheets in one document and then loop through a loop to get the summary file. However, I encountered the following issues:

- I cannot copy just reportfile.sheet1 as there are references to sheet2. Unless I copy and paste special which slows down excel and crashes it after inputting more than 30 reports.
- If I try to copy too many sheets to the report file I get an error "name already exists".

So my main question is if there is a better way of doing this and ensuring excel doesn't crash? Maybe using arrays and filling in the data without importing the sheets? But I am still learning how to properly use arrays.

This is my current code but as mentioned above it might be the wrong approach altogether.

Sub Mergefiles()
    Dim alistofnames, namelist As Variant 
    Dim worksheet_copy As Worksheet
    Dim workbook_cur, sourcewbk As Workbook
 
    alistofnames = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
    If (vbBoolean <> VarType(alistofnames)) Then
 
        If (UBound(alistofnames) > 0) Then
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
            Set workbook_cur = ActiveWorkbook
            For Each namelist In alistofnames 
                Set sourcewbk = Workbooks.Open(Filename:=namelist)
 
 
                For Each worksheet_copy In sourcewbk.Sheets
                    worksheet_copy.Copy After:=workbook_cur.Sheets(workbook_cur.Sheets.Count)
                Next
 
                sourcewbk.Close SaveChanges:=False
 
            Next
 
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
 
        End If
 
    Else
        MsgBox "No files selected", Title:="Merge files"
    End If
End Sub

 

[DanteAmor]

You can comment:
- For each file, you only need cells C10 and B23?
- Are those cells always on the first sheet of each file?
- Cell C10 in column 3 and cell B23 in column 5?
- The first sheet of each book is always called "Sheet1"?

 

[Neox]

Hi there are several cells but for the sake of the example, I only used two as I could later add more.

I managed to make a working example that doesn't crash after working on it for a few more days. It is quite fast but any suggestions on speeding it up would be welcome.

Sub Write_report()
    Dim numberOfFilesChosen, i As Integer
    Dim tempFileDialog As FileDialog
    Dim mainWorkbook, sourceWorkbook As Workbook
    Dim tempWorkSheet As Worksheet
    Dim countFiles As Integer
    
    Set mainWorkbook = Application.ActiveWorkbook
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    countFiles = 0

    tempFileDialog.AllowMultiSelect = True
    
    numberOfFilesChosen = tempFileDialog.Show
    
    For i = 1 To tempFileDialog.SelectedItems.Count
         countFiles = countFiles + 1
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

        Workbooks.Open tempFileDialog.SelectedItems(i)
        
        Set sourceWorkbook = ActiveWorkbook
       
        Set Rng = sourceWorkbook.Worksheets(1).Range("B10")
        mainWorkbook.Worksheets(1).Range("c" & i + 1).Resize(Rng.Rows.Count, Rng.Columns.Count).Cells.Value = Rng.Cells.Value

        
        sourceWorkbook.Close
    Next i
             Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
             MsgBox "Processed " & countFiles & " files" & vbCrLf, Title:="Merge Excel files"
End Sub