Join data in a single spreadsheet

Flocketz

New Member
Joined
Jul 3, 2021
Messages
1
Office Version
  1. 2007
Platform
  1. Windows
Hey, guys.

I am creating a VBA macro that combines spreadsheets that are within a folder picking up the data and joining them all into another spreadsheet. They have the same columns, but with different data.

My code:
VBA Code:
Sub ConslidateWorkbooks()

Dim verificador As Boolean
Dim celula As String

Path = "C:\dev\"
Filename = Dir(Path & "*.xlsx")

'Application.DisplayAlerts = False

Do While Filename <> ""
    Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

    For Each Sheet In ActiveWorkbook.Sheets
        Sheet.Copy After:=ThisWorkbook.Sheets(1)
    Next Sheet
    Workbooks(Filename).Close
    Filename = Dir()
    
    For Each aba In ThisWorkbook.Sheets
        
        If aba.Name <> "Dados" Then
        MsgBox aba.Name
            Range("A2").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Sheets("Dados").Select
            linha = Range("A1048576").End(xlUp).Row + 1
            Cells(linha, 3).Select
            ActiveSheet.Paste
        End If
    Next
    
Loop

Application.DisplayAlerts = True
End Sub

The data that supplies the main spreadsheet must be entered one below the other starting from the first empty row. But when I run the macro the data is inserted below the other but the repetition of the data table occurs.

But there is a problem. The image below shows the detail:
mgVGk.png


The main table is also being copied, but it shouldn't. Only the ones I added.
Example of how are the spreadsheets I'm getting the data:
cHyXr.png


And how the sheets are:
k5zQ1.png


Would anyone know how to explain to me how to solve this problem of data duplication?
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,111
Office Version
  1. 2013
Platform
  1. Windows
Welcome to the MrExcel Message Board!

At each pass of the loop your code copies data from the active sheet, rather than from one of the intended sheets. So it depends which sheet is active when this code is invoked and what the result is going to be. It's therefore recommended to write more explicit code, thereby avoiding implicit qualifiers for all member calls: for instance, don't use implicit ActiveSheet references or ActiveWorkbook references, they are more than often a source of bugs. Furthermore, it is recommended to always use the Option Explicit statement. Then the VBE compiler forces you to explicitly declare variables, although it does not check whether the variable is also typed (eg as String, Long, Date). Place the Option Explicit statement at the top of the code module. In addition, it is almost never necessary to use the Select method. The moment the range to be selected is not part of the active worksheet, a run-time error occurs.

Now that you're aware of the most common pitfalls, here's the modified code, with one more comment. The code fragment below which you did use:
VBA Code:
             linha = Range("A1048576").End(xlUp).Row + 1
             Cells(linha, 3).Select
determines the next empty cell downwards in column A, followed by a shift to column 3 on that particular row, where the data is pasted. With each pass, the same value will be assigned to the variable "linha", with the effect of pasting data in exactly the same place every time, overwriting previous data. I don't think this is your intention, so I left this part out.
Hopefully this is of some help.

VBA Code:
Sub Flocketz()

    Dim WbSource  As Workbook
    Dim WsSrc     As Worksheet
    Dim WsDest    As Worksheet

    Dim sPath       As String
    Dim FileName    As String

    sPath = "C:\dev\"
    FileName = Dir(sPath & "*.xlsx")

    Application.ScreenUpdating = False

    Do While FileName <> ""

        ' set a shorthand reference to the workbook to be opened
        Set WbSource = Workbooks.Open(FileName:=sPath & FileName, ReadOnly:=True)

        ' determine whether reference is valid and proceed if it's valid
        If Not WbSource Is Nothing Then

            For Each WsSrc In WbSource.Sheets
                WsSrc.Copy After:=ThisWorkbook.Sheets(1)
            Next WsSrc
            WbSource.Close

            ' set a shorthand reference to destination worksheet
            Set WsDest = ThisWorkbook.Sheets("dados")

            ' iterate through all sheets
            For Each WsSrc In ThisWorkbook.Sheets
                With WsSrc
                    ' exclude destination sheet as a source sheet
                    If .Name <> WsDest.Name Then

                        ' determine destination range on destination worksheet
                        Dim RngDest As Range
                        With WsDest
                            Set RngDest = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
                        End With

                        ' determine range on source sheet to be copied
                        Dim LastRow As Long
                        Dim LastCol As Long
                        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                        LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
                        ' copy source range to destination range
                        .Range("A2", .Cells(LastRow, LastCol)).Copy Destination:=RngDest
                    End If
                End With
            Next
        End If

        ' get next file in same folder
        FileName = Dir()
    Loop

    Application.ScreenUpdating = True
End Sub
 

Forum statistics

Threads
1,143,909
Messages
5,721,458
Members
422,363
Latest member
Bogus_Potatoes

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
Top