Search code examples
excelvbafilecopy-paste

Copy and Paste Data from Multiple Excel Files within the same folder into one Single Excel File


Good morning!

I'm trying to loop through Excel Files within the same folder to copy and paste a range of data into a single Excel Workbook.

The start location of the cell range is always consistent, it starts at Cell D12 and ends anywhere between C91 and Z91.The table dimensions however do vary from 80 R x 2 C to 80 R x 22 C. The Excel files I'm trying to pull the Data from have multiples sheets but the sheet where I need the Data from always has the same name, in this case its "Performance".

I need it to

  1. Find the data dimension in file (table)
  2. Copy that table
  3. Paste to destination (below previous table)
  4. Loop through to next file
  5. Repeat Step 1-4

Thanks a lot for any help, I appreciate any help, let me know if you have any specific questions.


Solution

  • SO isn't a code writing service, but yesterday I did something similar, that you can use for a starting point.

    Code is in one workbook. It creates a new workbook (Target) and loops the folder for all worksbooks (Source) and copies the worksheets from these to the target.

    Finally, saves the Target:

    Option Explicit
    
    Public Function ImportSheets()
    
        Dim Source          As Excel.Workbook
        Dim Target          As Excel.Workbook
        
        Const FolderName    As String = "C:\Path\SomeFolder"
        Const FileMask      As String = "*.xlsx"
        Const Separator     As String = "\"
        Const TargetMask    As String = "Current Projects {0}.xlsx"
        
        Dim Worksheet       As Excel.Worksheet
        
        Dim FileName        As String
        Dim Count           As Integer
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        Set Target = Workbooks.Add
        
        FileName = Dir(FolderName & Separator & FileMask)
        Do While FileName <> ""
            Set Source = Workbooks.Open(FolderName & Separator & FileName)
            For Each Worksheet In Source.Worksheets
                Count = Target.Worksheets.Count
                Source.Worksheets(Worksheet.Name).Copy After:=Target.Worksheets(Count)
            Next
            Source.Close False
            FileName = Dir()
        Loop
        Set Source = Nothing
        
        Target.Worksheets(1).Delete
        FileName = Replace(TargetMask, "{0}", Format(Date, "yyyy-mm-dd"))
        Target.SaveAs FolderName & Separator & FileName
        Target.Close
        Set Target = Nothing
        
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    
    End Function
    

    You should be able to expand it a bit to only copy a specific part of the source worksheets.