FROGGER24
Well-known Member
- Joined
- May 22, 2004
- Messages
- 704
- Office Version
- 2013
- 2010
- Platform
- 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.
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.