rajguptaji
04-07-2020, 08:12 AM
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
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