Copy Data From Two Source Workbooks Into Master Workbook-and getting subscript out range error

[9DravenAlpha]

Hi,

I have three workbooks located in a directory on my desktop. The master workbook is called MyCopyCode and it has a tab called Combo that I am trying to pull data in from two other source workbooks which are located in the same directory. In each of the source workbooks, the data is located on a tab called DayTab, and the data starts on row 2 and ranges from Columns A to AO. The source workbooks are updated each day so the row changes dynamically. So each day I have to run the code to pull in the data.

When I run the code, it copies the first source workbook data perfectly. When it loops to the second source workbook I get a subscript out of error #9. The code below shows in bold letters the line of code that is the issue. I am fairly new to excel vba and I have searched previous posts here/online but still can't narrow down the issue. I am new to this forum and its my first post.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Users\user\Desktop\Labor\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            .Sheets("DayTab").Range("A2:AO" & Range("A" & Rows.Count).End(xlUp).Row).Copy wkbDest.Sheets("Combo").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            '.Sheets("Combo").Range("D:D").Select
             'Selection.NumberFormat = "mm/dd/yyyy"
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Hi & welcome to MrExcel.
How about

    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource.Sheets("DayTab")
            .Range("A2:AO" & .Range("A" & Rows.Count).End(xlUp).Row).Copy wkbDest.Sheets("Combo").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop

 

[dmt32]

Hi,
try qualifying the ranges & see if this solves your issue

Sub CopyRange()
    Dim wkshDest As Worksheet
    Dim wkbSource As Workbook
    
    Set wkshDest = ThisWorkbook.Sheets("Combo")
    
    Const strPath As String = "C:\Users\danie\Desktop\Labor\"
    
    ChDir strPath
    strExtension = Dir("*.xls*")
    
    Application.ScreenUpdating = False
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension, False, True)
        With wkbSource
            With .Sheets("DayTab")
                .Range("A2:AO" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy wkshDest.Cells(wkshDest.Rows.Count, "A").End(xlUp).Offset(1, 0)
            End With
            .Close savechanges:=False
        End With
        Set wkbSource = Nothing
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Dave

 

[9DravenAlpha]

Thank you both for the above code. I've tried both codes and they've worked. The delay in my reply back was due to the holiday's along with getting this code into testing/production. Sorry for the delay.

The source files contain a range of dates that go from 11/01/2017 to 01/02/2020. I am trying to give users the option to pick a date range or looking all the way back to 2017. So on the Combo tab of the MyCopyCode book, I've inserted into Column C rows 2-4 the option to copy All Dates (Y or N), Start Date, and End Date. Their inputs will go into Column D. I've included a screen shot of the worksheet.

The code that I've so far is

Sub CopyWorkbooksInDirectory()

'This code will copy data from workbooks that are located in a directory
'The code is robust enough to copy the range of data that changes from one day to next

    Dim wkshDest As Worksheet
    Dim wkbSource As Workbook
    'Dim Start_Date, End_Date As Date
    
    Set wkshDest = ThisWorkbook.Sheets("Combo")
    
    Const strPath As String = "C:\Users\danie\Desktop\Labor\"
    
    ChDir strPath
    strExtension = Dir("*.xls*")
    
    'Start_Date = CDate(Combo.Cells(3, 4))
    'End_Date = CDate(Combo.Cells(4, 4))
    
    
    'Located in Row 2 of Column D, there will be a value of either Y or N.
    'If Combo.Cells(2, 4) = "Y" Then
        'Loop through Column D of the source files and copy the data to the combo sheet starting on Row 6 Column A
    'Else
        'Copy the entire data set of the source files and copy the data to the combo sheet starting on Row 6 Column A.  Does the code below for wkshdest.Rows.Count, should say A6
    Application.ScreenUpdating = False
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension, False, True)
        With wkbSource
            With .Sheets("DayTab")
                .Range("A2:AO" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy wkshDest.Cells(wkshDest.Rows.Count, "A6").End(xlUp).Offset(1, 0)
            End With
            .Close savechanges:=False
        End With
        Set wkbSource = Nothing
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Thank you in advance for helping.

 

[Fluff]

How about

Sub CopyWorkbooksInDirectory()

'This code will copy data from workbooks that are located in a directory
'The code is robust enough to copy the range of data that changes from one day to next

    Dim wkshDest As Worksheet
    Dim wkbSource As Workbook
    Dim Start_Date As Date, End_Date As Date
    
    Set wkshDest = ThisWorkbook.Sheets("Combo")
    
    Const strPath As String = "C:\Users\danie\Desktop\Labor\"
    
    ChDir strPath
    strExtension = Dir("*.xls*")
    
    Start_Date = CDate(Combo.Cells(3, 4))
    End_Date = CDate(Combo.Cells(4, 4))
    
    
    Application.ScreenUpdating = False
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension, False, True)
        With wkbSource
            With .Sheets("DayTab")
                If wkshDest.Cells(2, 4) = "N" Then
                   .Range("A2:AO" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy wkshDest.Cells(wkshDest.Rows.Count, "A6").End(xlUp).Offset(1, 0)
                Else
                   .Range("A1:AO1").AutoFilter 4, ">=" & Start_Date, xlAnd, "<=" & End_Date
                   .AutoFilter.Range.Offset(1).Copy wkshDest.Cells(wkshDest.Rows.Count, "A6").End(xlUp).Offset(1, 0)
                End If
            End With
            .Close savechanges:=False
        End With
        Set wkbSource = Nothing
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[9DravenAlpha]

Sorry for delay in reply. I had to bring together some other parts of the associated project, before this code be incorporated. I am going to try this within the next couple of days.