Copy range from multiple files - excel

Question

When trying to copy range("A2:H2") + End(xlDown) from multiple files into master Workbook
Run time error '424' Object Required
Sub Create()
Dim folderPath As String
Dim fileName As String
Dim erow As Long
Dim wbMaster As Workbook, wbTemp As Workbook
Dim wsMaster As Worksheet, wsTemp As Worksheet
folderPath= "\\Groups\DAILY RECON\October 2021"
Set wbMaster = ActiveWorkbook
Set wsMaster = wbMaster.Sheets("NY")
if Right(folderPath, 1)<> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.xlsm")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Do While fileName<>""
if fileName <> "master.xlsm" Then
Set wbTemp = Workbooks.Open(folderPath & fileName, ReadOnly= True)
Set wsTemp = wbTemp.Sheets("NY")
With wsMaster
erow = .Range("A" & .Rows.Count).End(xlUp).Row
ws.Temp.Range("A2:H2").Select ' ----> **Error**
Range(ActiveCell,ActiveCell.End(xlDown)).Select
Selection.Copy
.Range("A" & erow).Offset(1,0).PasteSpecial xlPasteValues
End With
wbTemp.Close False
Set wsTemp = Nothing
Set wbTemp = Nothing
End If
fileName = Dir
Loop
MsgBox "Finished"
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

Answer 1

Copy Range From Multiple Files
Option Explicit
Sub Create()
Dim wbMaster As Workbook, wbTemp As Workbook
Dim wsMaster As Worksheet, wsTemp As Worksheet
Dim mrg As Range, trg As Range
Dim mrrg As Range
Dim meRow As Long
Dim mFileName As String, tFileName As String
Dim tFolderPath As String
Dim rCount As Long
Dim cCount As Long
tFolderPath = "\\Groups\DAILY RECON\October 2021"
Set wbMaster = ActiveWorkbook ' ThisWorkbook ' workbook containing this code
Set wsMaster = wbMaster.Sheets("NY")
With wsMaster
meRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
cCount = wsMaster.Columns("A:H").Columns.Count
Set mrrg = .Range("A" & meRow).Resize(, cCount)
End With
mFileName = wbMaster.Name
If Right(tFolderPath, 1) <> "\" Then tFolderPath = tFolderPath & "\"
tFileName = Dir(tFolderPath & "*.xlsm")
Application.ScreenUpdating = False
Do While tFileName <> ""
If StrComp(tFileName, mFileName, vbTextCompare) <> 0 Then
Set wbTemp = Workbooks.Open(tFolderPath & tFileName, ReadOnly:=True)
On Error Resume Next ' check if exists
Set wsTemp = wbTemp.Sheets("NY")
On Error GoTo 0
If Not wsTemp Is Nothing Then ' it exists
With wsTemp.Range("A1").CurrentRegion.Columns("A:H")
Set trg = .Resize(.Rows.Count - 1).Offset(1)
End With
rCount = trg.Rows.Count
Set mrg = mrrg.Resize(rCount)
mrg.Value = trg.Value
Set mrrg = mrrg.Offset(rCount)
Set wsTemp = Nothing
End If
wbTemp.Close SaveChanges:=False
End If
tFileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Finished"
End Sub