Search code examples
vbaexcelworksheetconsolidation

Excel Macro: Copy Sheets from Multiple Workbooks WITH Added Refresh Capability


I am looking to merge sheets in multiple Excel files into one master file with refresh/update functionality.

To be more specific, I have ~25 workbooks in one folder which are identical in structure and vary based on entity. Each file has one sheet, which is identical to the name of the file. Each entity will update their specific file each week with up-to-date number values. I want to create a macro which will:

  1. Copy the one worksheet from each file and paste them in one "Master" workbook.
  2. Have the added functionality which allows me to "refresh" these copy/pasted tabs each week.

I have this code thus far:

Sub ConslidateWorkbooks()
'Code to pull sheets from multiple Excel files in one file directory
'into master "Consolidation" sheet.

Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet

Application.ScreenUpdating = False
FolderPath = "....."       'I have this filled in my code
Filename = Dir(FolderPath & "*.xls*")

Do While Filename <> ""
 Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
 For Each Sheet In ActiveWorkbook.Sheets
 Sheet.Copy After:=ThisWorkbook.Sheets(1)
 Next Sheet
 Workbooks(Filename).Close
 Filename = Dir()
Loop

Application.ScreenUpdating = True

End Sub

This code works fine to pull the data from multiple workbooks into a master workbook, but I need to add some sort of refresh capability WITHOUT deleting and re-copying the tabs (because I have links in other tabs in the Master sheet which will become #REF if sheets are deleted and re-copied).

Thank you for your help in advance.


Solution

  • Basically you want to refresh the worksheet's data if it already exists in ThisWorkbook, otherwise copy/add it. You can use this subroutine to accomplish this:

    Sub copyOrRefreshSheet(destWb As Workbook, sourceWs As Worksheet)
      Dim ws As Worksheet
      On Error Resume Next
      Set ws = destWb.Worksheets(sourceWs.Name)
      On Error GoTo 0
      If ws Is Nothing Then
        sourceWs.Copy After:=destWb.Worksheets(destWb.Worksheets.count)
      Else
        ws.Cells.ClearContents
        ws.Range(sourceWs.UsedRange.Address).value = sourceWs.UsedRange.Value2
      End If
    End Sub
    

    Now to use this, change this line from your routine's code:

    Sheet.Copy After:=ThisWorkbook.Sheets(1)
    

    into:

    copyOrRefreshSheet ThisWorkbook, sheet