VBA programming

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
        ' Get the next file in the folder
        MyFile = Dir

    ' Save the target workbook with consolidated data
    TargetWb.SaveAs "C:\YourTargetPath\ConsolidatedData.xlsx"
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

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

1 Like

It’s handled
Give a try and let us know for any clarification @shama93

Code is working but all the data isn’t being copied is respective it’s being copied in same sheet

1 Like

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

    ' Save the merged workbook
    DestWorkbook.SaveAs "C:\YourDestinationFolder\MergedData.xlsx" ' Update with your destination folder path and file name

    ' Close the merged workbook
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
 '   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..."
            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"

' Clean up
Set NewWorkbook = Nothing
Set CurrentWorksheet = Nothing
Set SourceWorkbook = Nothing
Set SourceWorksheet = Nothing

End Function

End Function