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]

it should be

Dir[COLOR=#ff0000]()[/COLOR]

 

[Jambi46n2]

Thank you for the reply!

I changed it to the following, but still get the same error on the same line:

    Dim wkbDest As Workbook    
    Dim wkbSource As Workbook
    Dim LastRow As Long
    Dim strPath As String
    Dim strExtension As String
    
    Set wkbDest = ThisWorkbook
    strPath = Range("G30").Value
    ChDir strPath
    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()[/COLOR]
    Loop

 

[Fluff]

You also need to change

strExtension = [COLOR=#ff0000]Dir(strPath & [/COLOR]"*.xlsx")
Do While strExtension <> ""

 

[Jambi46n2]

You also need to change

strExtension = [COLOR=#ff0000]Dir(strPath & [/COLOR]"*.xlsx")
Do While strExtension <> ""

This worked!!

You sir are a life saver. I can't thank you enough

 

[Fluff]

Glad to help & thanks for the feedback

 

[Jambi46n2]

Looks like I've come across another error that is unrelated to my original request.

"Can't paste because the copy area and paste area aren't the same size"

Don't suppose a good workaround for this?

I suspect this line needs to be modified:

.Sheets("SQL Pull").Range("A2:AV" & LastRow).Copy wkbDest.Sheets("Combined SQL Pull").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

 

[Fluff]

Do you have any merged cells in either sheet?
Also do you use Text to Columns?

 

[Jambi46n2]

Do you have any merged cells in either sheet?
Also do you use Text to Columns?

That's a no for both questions.

 

[Fluff]

Add the line in blue

    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("SQL Pull").Cells.find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            [COLOR=#0000ff]MsgBox LastRow & vbLf & wkbDest.Sheets("Combined SQL Pull").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row[/COLOR]
            .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
        strExtension = Dir()
    Loop

What does the message box say just before the code fails?