copy files to master list

trimmer69

Active Member
Joined
May 22, 2004
Messages
440
Office Version
  1. 2013
  2. 2007
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

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

Gokhan Aycan

Active Member
Joined
Aug 8, 2021
Messages
396
Office Version
  1. 365
Platform
  1. Windows
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?
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,147
Office Version
  1. 2013
Platform
  1. Windows
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
 

Forum statistics

Threads
1,144,342
Messages
5,723,818
Members
422,518
Latest member
quack_quack

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
Top