Sub Rajeev() Dim temp As New Workbook, wkb As Workbook Dim sh, sh1, sh2, sh3, sh4, sh5, sh6 As Worksheet, w_dpr As Worksheet, w_cc As Worksheet, w_c1 As Worksheet, w_c2 As Worksheet, w_c3 As Worksheet, w_c4 As Worksheet, w_c5 As Worksheet, w_dpr1 As Worksheet, w_dpr2 As Worksheet, w_c9 As Worksheet Dim MyFolder As String Dim MyFile As String Dim lRow As Long Dim lrow1 As Long Dim j As Integer, k As Integer, L As Integer Set wkb = ThisWorkbook Set w_dpr = wkb.Sheets("INSTALL(WIP)") Set w_dpr1 = wkb.Sheets("Disconnect(WIP)") Set w_dpr2 = wkb.Sheets("CCD") Set w_cc = wkb.Sheets("Test & Accept Queue") Set w_c1 = wkb.Sheets("Cancel Orders") Set w_c2 = wkb.Sheets("Onshore Reassignment") ' HERE THE ERROR COMING' 'Set w_c3 = wkb.Sheets("Billed_RTP-Orders") 'Set w_c4 = wkb.Sheets("CCD") Set w_c5 = wkb.Sheets("ClickIT Tickets") w_dpr.Range("A2:Z1000000").ClearContents w_dpr1.Range("A2:Z1000000").ClearContents w_dpr2.Range("A2:Z1000000").ClearContents MyFolder = wkb.Sheets("Overall Snapshot").Range("AQ1").Value MyFile = Dir(MyFolder & "\*.xls*") Do While MyFile <> "" Set temp = Workbooks.Open(Filename:=MyFolder & "" & MyFile) On Error Resume Next temp.Activate Set sh = ActiveWorkbook.Sheets("INSTALL(WIP)") If Err.Number <> 0 Then Err.Clear On Error GoTo 0 Else temp.Activate sh.Activate If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData End If lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row sh.Range("A2:Z" & lRow).Copy wkb.Activate w_dpr.Activate lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row lrow1 = lrow1 + 1 w_dpr.Range("A" & lrow1).Activate w_dpr.Range("A" & lrow1).PasteSpecial Application.CutCopyMode = False End If On Error Resume Next temp.Activate Set sh1 = ActiveWorkbook.Sheets("Test & Accept Queue") If Err.Number <> 0 Then 'MsgBox "The sheet doesn't exist" Err.Clear On Error GoTo 0 Else temp.Activate sh1.Activate If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData End If lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row sh1.Range("A2:Z" & lRow).Copy wkb.Activate w_cc.Activate lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row lrow1 = lrow1 + 1 w_cc.Range("A" & lrow1).Activate w_cc.Range("A" & lrow1).PasteSpecial Application.CutCopyMode = False End If On Error Resume Next temp.Activate Set sh2 = ActiveWorkbook.Sheets("Cancel Orders") If Err.Number <> 0 Then 'MsgBox "The sheet doesn't exist" Err.Clear On Error GoTo 0 Else temp.Activate sh2.Activate If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData End If lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row sh2.Range("A2:Z" & lRow).Copy wkb.Activate w_c1.Activate lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row lrow1 = lrow1 + 1 w_c1.Range("A" & lrow1).Activate w_c1.Range("A" & lrow1).PasteSpecial Application.CutCopyMode = False End If On Error Resume Next Set sh3 = ActiveWorkbook.Sheets("Disconnect(WIP)") If Err.Number <> 0 Then Err.Clear On Error GoTo 0 Else temp.Activate sh3.Activate If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData End If lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row sh3.Range("A2:Z" & lRow).Copy wkb.Activate w_dpr1.Activate lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row lrow1 = lrow1 + 1 w_dpr1.Range("A" & lrow1).Activate w_dpr1.Range("A" & lrow1).PasteSpecial Application.CutCopyMode = False End If On Error Resume Next temp.Activate Set sh4 = ActiveWorkbook.Sheets("CCD") If Err.Number <> 0 Then Err.Clear On Error GoTo 0 Else temp.Activate sh4.Activate If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData End If lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row sh4.Range("A2:Z" & lRow).Copy wkb.Activate w_dpr2.Activate lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row lrow1 = lrow1 + 1 w_dpr2.Range("A" & lrow1).Activate w_dpr2.Range("A" & lrow1).PasteSpecial Application.CutCopyMode = False End If temp.Close savechanges:=False MyFile = Dir Loop wkb.Activate w_dpr.Activate w_dpr.Range("A1:A1000").Select On Error Resume Next w_dpr.Columns("A1:A1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Rows("2:1000").RowHeight = 15 On Error GoTo 0 w_cc.Activate w_cc.Range("A1:A1000").Select On Error Resume Next w_cc.Columns("A1:A1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 Rows("2:1000").RowHeight = 15 w_c1.Activate w_c1.Range("A1:A1000").Select On Error Resume Next w_c1.Columns("A1:A1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Rows("2:1000").RowHeight = 15 On Error GoTo 0 End Sub