VBA: Consolidate Selected Worksheet from Multiple Workbooks from OneDrive

datastudent

Board Regular
Joined
Sep 7, 2021
Messages
72
Office Version
  1. 365
Platform
  1. Windows
Hi,

I'm new to VBA so I would like to ask some help. I have a folder in OneDrive which has several workbooks. Each workbook has multiple sheets and each of them are different. I want to consolidate each specific sheet in each workbook and put them in a Master File in my computer. But also customize the sheet name when consolidated in the Master file.

This is what I currently have. I don't know if its correct though. Please help!

Master File: Carrier_Rate_Cards.xlsm
Workbook NameWorkbook Sheet NameNew Sheet Name in Master File
Casiguran Rate.xlsxITFSCasRateITFS
Sorsogon Rate.xlsxDomestic RatesSorRateDom
Cawit Rate 01.10.25.xlsxCode ChangesCawitRate
VoxOut National.xlsxInVoxOut
VoxDID MCR.xlsxRangesVoxDID


Sub ConsolidateWorkbooksFromOneDriveWithCustomNamesAndWorksheets()
Dim folderPath As String
Dim fileName As String
Dim wbSource As Workbook
Dim wbDest As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim lastRowSource As Long
Dim lastColSource As Long
Dim lastRowDest As Long
Dim newSheetName As String
Dim sheetList As Object
Dim selectedSheetName As String
Dim sheetName As Variant


folderPath = "C:\Users\iReply\OneDrive\Test"
Set wbDest = Carrier_Rate_Cards.xlsm

Set sheetNamesDict = CreateObject("Scripting.Dictionary")
sheetNamesDict.Add "Casiguran Rate.xlsx", "ITFS"
sheetNamesDict.Add "Sorsogon Rate.xlsx", "Domestic Rates"
sheetNamesDict.Add "Cawit Rate 01.10.25.xlsx", "Code Changes"
sheetNamesDict.Add "VoxOut National.xlsx", "In"
sheetNamesDict.Add "VoxDID MCR.xlsx", "Ranges"

fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
If sheetNamesDict.Exists(fileName) Then
Set wbSource = Workbooks.Open(folderPath & fileName)
targetSheetName = sheetNamesDict(fileName)
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Untested here. Paste in a Regular Module into a workbook other than the Master Workbook. The Master Workbook and this 'other' workbook should
be in the same folder on OneDrive as the source workbooks. Edit the path in the macro to suit your situation there.

You can avoid having to use a separate workbook to paste the macro into if you delete the following line of code :
Code:
 ' Open the Master File

    Set MasterFile = Workbooks.Open(FilePath & "Carrier_Rate_Cards.xlsm")

If you choose to do this, you can paste the following macro directly into the Master Workbook, in a Regular Module, and run it
from there. The Master Workbook still has to be located in the same OneDrive folder as the source workbooks.

Once all source workbooks have been opened and closed ... and all sheets have been pasted into the Master Workbook, the
Master Workbook will be saved and closed automatically. If you don't want the workbook to close, either 'comment out' the following
lines of code or delete them altogether from the macro.

Code:
 ' Save and close the Master File

    MasterFile.Save

    MasterFile.Close



VBA Code:
Sub ConsolidateSheets()
    Dim MasterFile As Workbook
    Dim SourceFile As Workbook
    Dim SheetToCopy As Worksheet
    Dim NewSheet As Worksheet
    Dim FilePath As String
    Dim FileNames As Variant
    Dim SheetNames As Variant
    Dim NewSheetNames As Variant
    Dim i As Integer
    
    ' Define the file path to the folder containing the source workbooks
    FilePath = "C:\\Users\\YourUsername\\OneDrive\\FolderName\\"
    
    ' Define the arrays with workbook names, sheet names, and new sheet names
    FileNames = Array("Casiguran Rate.xlsx", "Sorsogon Rate.xlsx", "Cawit Rate 01.10.25.xlsx", "VoxOut National.xlsx", "VoxDID MCR.xlsx")
    SheetNames = Array("ITFS", "Domestic Rates", "Code Changes", "In", "Ranges")
    NewSheetNames = Array("CasRateITFS", "SorRateDom", "CawitRate", "VoxOut", "VoxDID")
    
    ' Open the Master File
    Set MasterFile = Workbooks.Open(FilePath & "Carrier_Rate_Cards.xlsm")
    
    ' Loop through each source workbook
    For i = 0 To UBound(FileNames)
        ' Open the source workbook
        Set SourceFile = Workbooks.Open(FilePath & FileNames(i))
        
        ' Set the sheet to copy
        Set SheetToCopy = SourceFile.Sheets(SheetNames(i))
        
        ' Copy the sheet to the Master File
        SheetToCopy.Copy After:=MasterFile.Sheets(MasterFile.Sheets.Count)
        
        ' Rename the copied sheet in the Master File
        Set NewSheet = MasterFile.Sheets(MasterFile.Sheets.Count)
        NewSheet.Name = NewSheetNames(i)
        
        ' Close the source workbook without saving
        SourceFile.Close SaveChanges:=False
    Next i
    
    ' Save and close the Master File
    MasterFile.Save
    MasterFile.Close
End Sub
 
Upvote 0
Solution
You are welcome. Glad to help.
 
Upvote 0

Forum statistics

Threads
1,226,462
Messages
6,191,177
Members
453,644
Latest member
karlpravin

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