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

9DravenAlpha

New Member
Joined
Nov 28, 2019
Messages
8
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2013
Platform
  1. Windows
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.


Rich (BB code):
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
 
Last edited by a moderator:

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Hi & welcome to MrExcel.
How about
VBA Code:
    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
 
Upvote 0
Hi,
try qualifying the ranges & see if this solves your issue

VBA Code:
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
 
Upvote 0
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.

MrExcelUpload.png


The code that I've so far is


VBA Code:
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.
 
Upvote 0
How about
VBA Code:
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,998
Members
448,541
Latest member
iparraguirre89

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top