VBA error in copying the workbooks to new workbook - excel

Question

I am trying the combine the all workbooks from a folder after some changes into on one new workbook, each workbook has only one sheet. But my code is not woking at following line:
wksCurSheet.Copy After:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Could you please check what is causing the error?
Sub CombineIDBISheet()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim wksCurSheet As Worksheet
Dim wbkCurBook As Workbook
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
Set wbkCurBook = ActiveWorkbook
If Range("B4") = "Search Criteria" Then
Cells.WrapText = False
Cells.UnMerge
Dim x
With Range("d7", Range("d" & Rows.Count).End(xlUp))
x = .Address
.Value = Evaluate("index(date(mid(" & x & ",7,4),mid(" & x & ",4,2),left(" & x & ",2))+timevalue(right(" & x & ",8)),,)")
.NumberFormat = "dd/mm/yyyy hh:mm:ss"
With .Offset(, 1)
.TextToColumns .Cells(1), 1, FieldInfo:=Array(1, 4)
.NumberFormat = "dd/mm/yyyy"
End With
End With
With Range("j7:k" & Cells(Rows.Count, 4).End(xlUp).Row)
.Value = .Value
.UnMerge
End With
Range("b3:b5").Copy Range("c3:c5")
Columns("a:b").EntireColumn.Delete
Columns("i").EntireColumn.AutoFit
Columns("L:p").EntireColumn.Delete
Else
End If
Range("B4").ClearContents
wksCurSheet.Copy After:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
ActiveWorkbook.Close SaveChanges:=True
End With
xFileName = Dir
Loop
End If
End Sub