none
Can't get the script to consolidate data side-by-side RRS feed

  • Question

  • Hi everyone,
    I'd really appreciate if someone helped me with this problem. Admittedly, I'm very new to all this so please go easy on me.
    I have a code that consolidates data from a large number of workbooks to a single master worksheet. I'm targeting same cells from different workbooks (for example A5 from all workbooks and pasting them into my worksheet as a list under A1, and A13 under B1, etc). But when I change the code at this line from "A" to "B"  and run it again to get other column of data:

    Set CopyRng = Wkb.Sheets(1).Cells(9, 1)

    Set Dest = shtDest.Range("B" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)

    it goes to the next column AND the next row. e.g. when A1 to A11 is finished, it starts pasting to B12 d(iagonally) in the destination worksheet, rather than starting from B1 (side-by-side).

    Here is the code:

    Sub MergeFiles()
        Dim path As String, ThisWB As String, lngFilecounter As Long
        Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
        Dim Filename As String, Wkb As Workbook
        Dim CopyRng As Range, Dest As Range
        Dim RowofCopySheet As Integer
    
        RowofCopySheet = 1 'Row to start on in the sheets you are copying from
    
        ThisWB = ActiveWorkbook.Name
    
        path = "C:\batch"
    
        Application.EnableEvents = False
        Application.ScreenUpdating = False
    
        Set shtDest = ActiveWorkbook.Sheets(1)
        Filename = Dir(path & "\*.csv", vbNormal)
        If Len(Filename) = 0 Then Exit Sub
        Do Until Filename = vbNullString
            If Not Filename = ThisWB Then
                Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
                Set CopyRng = Wkb.Sheets(1).Cells(3, 1)
                Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
                CopyRng.Copy Dest
                Wkb.Close False
            End If
    
            Filename = Dir()
        Loop
    
        Range("A1").Select
    
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    
        MsgBox "Done!"
    End Sub





    • Edited by AresHera Sunday, April 1, 2018 2:25 AM Typo
    Sunday, April 1, 2018 2:23 AM

All replies

  • Hello AresHera,

    Please try to refer to below code to get last row.

    Do Until Filename = vbNullString
            If Not Filename = ThisWB Then
                Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
                Set CopyRng = Wkb.Sheets(1).Cells(3, 1)
                'column A last row +1
                lastRow = shtDest.Cells(shtDest.Rows.Count, 1).End(xlUp).Row + 1
                'set dest in column A or column B according your need
                Set Dest = shtDest.Range("A" & lastRow)
                CopyRng.Copy Dest
                Wkb.Close False
            End If
    
            Filename = Dir()
        Loop

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.


    Monday, April 2, 2018 2:04 AM