Hello all,
I’m pretty new to VBA.
Need your help.
My query is “Merge Data into single file from Multiple Workbooks in multiple sheets and skip the sheet if it is empty or same data is available”.
I have nearly 15 workbooks and each one has 3 sheets, so I wanted to create a new workbook and sheet and paste the data into respective sheets.
I tried multiple codes but getting errors.
If someone could give me the code here that should be a great help.
Thank you.
Hi @shama93 ,
Have you tried with the Excel Activities set or do you need it to be with VBA only ?
With the help of Excel Modern activities (Latest Stable versions), we should be able to do it with ease :
If you could provide us with a Sample set of Data and the Expected Output Excel sheet, it would help us provide better suggestions.
However, do take a look at the below Skeleton workflow which should be the scenario for your case :
DT_MergeSheetsFromFiles_BasedOnSheetNames.zip (17.7 KB)
I’m supposed to do only with vba, not UiPath
Here u go
Sub MergeDataFromWorkbooks()
Dim MyPath As String
Dim MyFile As String
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim ws As Worksheet
Dim wsTarget As Worksheet
Dim EmptyCheck As Long
' Define the path to the folder containing your workbooks
MyPath = "C:\YourFolderPath\"
' Define the target workbook where you want to consolidate data
Set TargetWb = Workbooks.Add
' Loop through files in the folder
MyFile = Dir(MyPath & "*.xlsx")
Do While MyFile <> ""
' Open the source workbook
Set SourceWb = Workbooks.Open(MyPath & MyFile)
' Loop through sheets in the source workbook
For Each ws In SourceWb.Sheets
' Check if the sheet is not empty
EmptyCheck = Application.WorksheetFunction.CountA(ws.UsedRange)
If EmptyCheck > 0 Then
' Check if a sheet with the same name already exists in the target workbook
On Error Resume Next
Set wsTarget = TargetWb.Sheets(ws.Name)
On Error GoTo 0
' If a sheet with the same name doesn't exist, create one
If wsTarget Is Nothing Then
Set wsTarget = TargetWb.Sheets.Add(After:=TargetWb.Sheets(TargetWb.Sheets.Count))
wsTarget.Name = ws.Name
End If
' Copy data from the source sheet to the target sheet
ws.UsedRange.Copy wsTarget.Range("A1")
End If
Next ws
' Close the source workbook
SourceWb.Close
' Get the next file in the folder
MyFile = Dir
Loop
' Save the target workbook with consolidated data
TargetWb.SaveAs "C:\YourTargetPath\ConsolidatedData.xlsx"
TargetWb.Close
End Sub
Make sure to replace "C:\YourFolderPath\" with the path to the folder containing your source workbooks, and "C:\YourTargetPath\ConsolidatedData.xlsx" with the desired path and filename for your consolidated workbook.
Use invoke VBA activity in UiPath
https://docs.uipath.com/activities/other/latest/productivity/invoke-vba
Cheers @shama93
Thanq so much.
But need a little more clarity,
As I already mentioned there are 15 files/workbooks and each workbook has got 3 sheets, so while merging the data must be copied into their respective sheets and few sheets are empty, such sheets must be skipped.
Pls help
Code is working but all the data isn’t being copied is respective it’s being copied in same sheet
Try with this
Sub MergeDataToRespectiveSheets()
Dim SourceFolder As String
Dim DestWorkbook As Workbook
Dim SourceWorkbook As Workbook
Dim ws As Worksheet
Dim DestSheet As Worksheet
Dim cell As Range
Dim i As Integer
' Set the source folder path where your workbooks are located
SourceFolder = "C:\YourSourceFolder\" ' Update with your folder path
' Create a new workbook for merged data
Set DestWorkbook = Workbooks.Add
' Loop through each file in the source folder
Filename = Dir(SourceFolder & "*.xlsx")
Do While Filename <> ""
' Open the source workbook
Set SourceWorkbook = Workbooks.Open(SourceFolder & Filename)
' Loop through each worksheet in the source workbook
For Each ws In SourceWorkbook.Sheets
' Check if the worksheet is not empty
If Application.WorksheetFunction.CountA(ws.UsedRange) > 0 Then
' Check if the worksheet with the same name exists in the destination workbook
On Error Resume Next
Set DestSheet = DestWorkbook.Sheets(ws.Name)
On Error GoTo 0
If DestSheet Is Nothing Then
' If the sheet doesn't exist in the destination workbook, create it
Set DestSheet = DestWorkbook.Sheets.Add(, DestWorkbook.Sheets(DestWorkbook.Sheets.Count))
DestSheet.Name = ws.Name
End If
' Copy data from the source sheet to the destination sheet
ws.UsedRange.Copy DestSheet.Cells(DestSheet.Cells(DestSheet.Rows.Count, "A").End(xlUp).Row + 1, 1)
End If
Next ws
' Close the source workbook without saving
SourceWorkbook.Close SaveChanges:=False
' Get the next file in the folder
Filename = Dir
Loop
' Save the merged workbook
DestWorkbook.SaveAs "C:\YourDestinationFolder\MergedData.xlsx" ' Update with your destination folder path and file name
' Close the merged workbook
DestWorkbook.Close
End Sub
Cheers @shama93
Can someone help what’s wrong with below code.
I’m trying to create a 3 new sheets in current workbook and trying to merge data in respective sheets.
Sub CopyDataToNewWorkbook()
Dim NewWorkbook As Workbook
Dim CurrentWorksheet As Worksheet
Dim SourceWorkbook As Workbook
Dim SourceWorksheet As Worksheet
Dim LastRow As Long
Dim customName As String
Dim savePath As String
Dim ws As Worksheet
Dim i As Integer
Dim wsNames(1 To 3) As String
Dim wsName As String
' Create a new workbook
'customeName = "customname"
'savePath = "C:\Users\Desktop\"
'customName = Application.GetSaveAsFilename(InitialFileName:=savePath & customName, FileFilter:="Excel Files (*.xlsx), *.xlsx")
'If customName <> "False" Then
' Create a new workbook and save it with the custom name
' Set NewWorkbook = Workbooks.Add
' NewWorkbook.SaveAs customName
'Else
' MsgBox "No workbook was created. The user canceled the save dialog."
'End If
' Hardcoded names for the new worksheets
'Function WorksheetExists(wsName As String) As Boolean
’ On Error Resume Next
’ WorksheetExists = Not ThisWorkbook.Sheets(wsName) Is Nothing
’ On Error GoTo 0
wsNames(1) = "sheet1"
wsNames(2) = "sheet2"
wsNames(3) = "Sheet3"
For i = 1 To 3
' Check if the worksheet name is not empty
wsName = wsNames(i)
If wsName <> "" Then
' Check if the worksheet name already exists
If WorksheetExists(wsName) Then
MsgBox "Worksheet '" & wsName & "' already exists. Skipping..."
Else
Set ws = NewWorkbook.Sheets.Add(, NewWorkbook.Sheets(NewWorkbook.Sheets.Count))
ws.Name = wsName
End If
End If
'On Error Resume Next
'WorksheetExists = Not NewWorkbook.Sheets(wsName) Is Nothing
'On Error GoTo 0
Next i
SourceWorkbook = "C:\Users\Downloads\path"
' Reference the current worksheet in the new workbook
'NewWorkbook.Sheets(1).Name = "NewWorksheet" ' Change the sheet name as desired
'Set CurrentWorksheet = NewWorkbook.Sheets(1)
' Loop through the workbooks you want to copy data from
For Each SourceWorkbook In Workbooks
' Check if the workbook is not the new workbook and is open
If SourceWorkbook.Name <> NewWorkbook.Name And SourceWorkbook.Name <> ThisWorkbook.Name Then
' Reference the source worksheet (change "Sheet1" to the name of the source sheet)
Set SourceWorksheet = SourceWorkbook.Sheets("source sheet")
' Find the last row in the current worksheet
LastRow = CurrentWorksheet.Cells(CurrentWorksheet.Rows.Count, "A").End(xlUp).Row
' Copy data from the source worksheet to the current worksheet in the new workbook
SourceWorksheet.UsedRange.Copy CurrentWorksheet.Cells(LastRow + 1, 1)
End If
Next SourceWorkbook
' Save and close the new workbook (you can customize the file path and name)
NewWorkbook.SaveAs "C:\Users\Copy.xlsm"
NewWorkbook.Close
' Clean up
Set NewWorkbook = Nothing
Set CurrentWorksheet = Nothing
Set SourceWorkbook = Nothing
Set SourceWorksheet = Nothing
End Function
End Function
rikulsilva
Yoichi
ppr
Shiva_Nikhil
Parvathy
jenn.cruz
Sanket_Shinde1
22222222asas
n.prettytake
sasi_poosarla