copy files to master list

FROGGER24

Well-known Member
Joined
May 22, 2004
Messages
704
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
I have this code that copies about 65.5K rows of data where as I was expecting the code to copy about 150K rows of data. All the files in the EMS-PMA directory extension is XLS while the master worksheet is XLSM.

Sub CopyRange()
Application.ScreenUpdating = False
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim LastRow As Long
Const strPath As String = "C:\Users\??????\Desktop\EMS-PMA 2021\"

ChDir strPath
strExtension = Dir("*.xls*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath & strExtension)
With wkbSource
LastRow = .Sheets("Sheet1").Cells(Rows.Count, 28).End(xlUp).Row
.Sheets("Sheet1").Range("X1:AE" & LastRow).Copy wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
.Close savechanges:=False
End With
strExtension = Dir
Loop
Application.ScreenUpdating = True
End Sub

Thanks for any guidance provided.
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Not sure what the problem is exactly, but 65536 is a very familiar number (2 ^ 16). I wonder if you are hitting some kind of data type limit. But I can't seem to find anything... Are you sure every file is processed?
 
Upvote 0
XLS files are limited to 65,535 rows while XLSX/XLSM worksheets contain 1,048,576 rows. You did not qualify all the used objects within your code, so at some point you were (implicitly) dealing with the limitations of the active worksheet. Therefore explicitly qualifying all objects is recommended.

VBA Code:
Sub CopyRange()
    
    Const FilePath As String = "C:\Users\??????\Desktop\EMS-PMA 2021\"

    Application.ScreenUpdating = False
    
    Dim wsDest      As Worksheet
    Dim wbSource    As Workbook
    Dim SrcLastRow  As Long
    Dim FileName    As String

    Set wsDest = ThisWorkbook.Sheets("Master")

    FileName = Dir(FilePath & "\*.xls*")

    Do While FileName <> ""
        Set wbSource = Workbooks.Open(FilePath & FileName)
        With wbSource
            With .Sheets("Sheet1")
                SrcLastRow = .Cells(.Rows.Count, 28).End(xlUp).Row
                .Range("X1:AE" & SrcLastRow).Copy wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1, 0)
            End With
            .Close savechanges:=False
        End With
        FileName = Dir
    Loop

    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,245
Members
448,555
Latest member
RobertJones1986

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