VBA Help for Combining Multiple Workbooks into One Worksheet.

[Jambi46n2]

    Dim wkbDest As Workbook    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Dim strPath As String
    strPath = Range("G30").Value
    ChDir strPath
    Dim strExtension As String
    strExtension = ("*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("SQL Pull").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("SQL Pull").Range("A2:AV" & LastRow).Copy wkbDest.Sheets("Combined SQL Pull").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
[COLOR=#ff0000]        strExtension = Dir '<----- Run Time Error 5 here. "Invalid Procedure Call or Argument" [/COLOR]
    Loop

The Code Above was intended to grab every file with the extension .xlsx from the folder path pasted in cell G30. Then find the worksheet named "SQL Pull", copy all the data minus the header, and paste into the workbook that is currently opened into the sheet "Combined SQL Pull". The code works for a little bit, then errors on the line in red above.

Can someone please assist on what needs to be done to make this work correctly?

Thank you in advance.

 

[Fluff]

Another thought. Is the destination sheet filtered?

 

[Jambi46n2]

The destination sheet is not filtered. It's a newly created sheet.

Here's the msgbox info until it errors:

MsgBox 1
508517
2

MsgBox 2
537751
508518

MsgBox 3 <---- Error occurs after this one
407120
1046268

 

[Fluff]

That's your problem then.
You're trying to copy 407,120 rows starting in row 1,046,268 which will take you to row 1,453,388, but there are only 1,048,576 rows available.

 

[Jambi46n2]

Makes sense.. Is there a way I can paste the data into empty columns towards the right, as opposed to pasting everything down into rows?

I really only need about 4 columns of data from each workbook/sheet.

 

[Fluff]

Something like

   Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            lastrow = .Sheets("SQL Pull").Cells.find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lr2 = wkbDest.Sheets("Combined SQL Pull").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
            If lastrow + lr2 < wkbDest.Sheets("Combined SQL Pull").Rows.Count Then
               .Sheets("SQL Pull").Range("A2:AV" & lastrow).Copy wkbDest.Sheets("Combined SQL Pull").Cells(lr2, "A")
               .Close savechanges:=False
            Else
               wkbDest.Sheets.Add.Name = "Continue"
               .Sheets("SQL Pull").Range("A2:AV" & lastrow).Copy wkbDest.Sheets("Continue").Cells(1, "A")
               .Close savechanges:=False
            End If
        End With
        strExtension = Dir()
    Loop

 

[Jambi46n2]

Your code above is great!

Looks like I'm working with a larger data set than I originally thought.

It continues to fill up the second sheet as well.

I'm thinking about having it just copy and paste into one sheet in the empty columns going xlright.

I really appreciate all your help and taking the time.

Thank you again.

 

[Fluff]

Glad to help & thanks for the feedback