Loop inserting worksheet name in column - mismatch error - vba

Question

Trying to do the following
1- Open directory with multiple workbooks (Origins), copy/paste
each worksheet into Master workbook (Destin)
2- insert in Columns 'A' in Master worksheet (Destin) with the name of each worksheet from dir (Origin) - the worksheets name contain the date
3- Finally, consolidate all worksheets in Master workbook (Destin) into 'Summary' sheet by copy/paste each
worksheet below the other (i.e. database format)
got step-1 to work....stuck now (step-2 mismatch error)
Option Explicit
Sub AllFiles()
'Application.EnableCancelKey = xlDisabled
Application.DisplayAlerts = True
Application.ScreenUpdating = False
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
Dim Masterwb As Workbook
Dim sh As Worksheet
Dim NewSht As Worksheet
Dim FindRng As Range
Dim PasteRow As Long
Dim lastrow As Long
' set master workbook
Set Masterwb = Workbooks("masterbook_AAFC.xlsm")
folderPath = "C:\Users\axchilmeran.G3NETWORK\Downloads\Master_AAFC\" 'contains folder path
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
Filename = Dir(folderPath & "*.csv*")
Do While Filename <> ""
Set wb = Workbooks.Open(folderPath & Filename)
If Len(wb.Name) > 35 Then
MsgBox "Sheet's name can be up to 31 characters long, shorten the Excel file name"
wb.Close False
GoTo Exit_Loop
Else
' add a new sheet with the file's name (remove the extension)
Set NewSht = Masterwb.Worksheets.Add(After:=Masterwb.Worksheets(1))
NewSht.Name = Replace(wb.Name, ".pdf.csv", "")
End If
' loop through all sheets in opened wb
For Each sh In wb.Worksheets
' get the first empty row in the new sheet
Set FindRng = NewSht.Cells.Find(What:="*", Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
If Not FindRng Is Nothing Then ' If find is successful
PasteRow = FindRng.Row + 1
Else ' find was unsuccessfull > new empty sheet, should paste at the first row
PasteRow = 1
End If
sh.UsedRange.Copy
NewSht.Range("B" & PasteRow).PasteSpecial xlPasteValues
these 2 lines below giving me mismatch error!
**lastrow = NewSht.UsedRange.Rows(NewSht.UsedRange.Rows.Count).Row
Worksheets(NewSht).Range("A2:A" & lastrow).Value = NewSht.Name**
Next sh
wb.Application.CutCopyMode = False
wb.Close False
Exit_Loop:
Set wb = Nothing
Filename = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub