Join data in a single spreadsheet

[Flocketz]

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:

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:

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:

And how the sheets are:

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

 

[GWteB]

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:

             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.

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