Posts by rajguptaji

There is some bug in the program while defining the variable - Set w_c2 = wkb.Sheets("Onshore Reassignment")

Sub Rajeev()

Dim temp As New Workbook, wkb As Workbook

Dim sh, sh1, sh2, sh3, sh4, sh5, sh6, sh7, sh8, sh9 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_dpr3 As Worksheet, W_dpr4 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("VTA(WIP)")

Set W_dpr3 = wkb.Sheets("Change(WIP)")

Set W_dpr4 = wkb.Sheets("TSP(WIP)")

Set w_cc = wkb.Sheets("Test & Accept Queue")

Set w_c1 = wkb.Sheets("Cancel Orders")

Set w_c2 = wkb.Sheets("Onshore Reassignment")

'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

W_dpr3.Range("A2:Z1000000").ClearContents

w_cc.Range("A2:Z1000000").ClearContents

w_c1.Range("A2:K1000000").ClearContents

w_c2.Range("A2:K1000000").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("VTA(WIP)")

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

On Error Resume Next

temp.Activate

Set sh5 = ActiveWorkbook.Sheets("Change(WIP)")

If Err.Number <> 0 Then

Err.Clear

On Error GoTo 0

Else

temp.Activate

sh5.Activate

If ActiveSheet.FilterMode = True Then

ActiveSheet.ShowAllData

End If

lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

sh5.Range("A2:Z" & lRow).Copy

wkb.Activate

W_dpr3.Activate

lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

lrow1 = lrow1 + 1

W_dpr3.Range("A" & lrow1).Activate

W_dpr3.Range("A" & lrow1).PasteSpecial

Application.CutCopyMode = False

End If

On Error Resume Next

temp.Activate

Set sh6 = ActiveWorkbook.Sheets("TSP(WIP)")

If Err.Number <> 0 Then

Err.Clear

On Error GoTo 0

Else

temp.Activate

sh6.Activate

If ActiveSheet.FilterMode = True Then

ActiveSheet.ShowAllData

End If

lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

sh6.Range("A2:Z" & lRow).Copy

wkb.Activate

W_dpr4.Activate

lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

lrow1 = lrow1 + 1

W_dpr4.Range("A" & lrow1).Activate

W_dpr4.Range("A" & lrow1).PasteSpecial

Application.CutCopyMode = False

End If

On Error Resume Next

temp.Activate

Set sh7 = ActiveWorkbook.Sheet("Test & Accept Queue")

If Err.Number <> 0 Then

Err.Clear

On Error GoTo 0

Else

temp.Activate

sh7.Activate

If ActiveSheet.FilterMode = True Then

ActiveSheet.ShowAllData

End If

lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

sh7.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 sh8 = ActiveWorkbook.Sheet("Cancel Orders")

If Err.Number <> 0 Then

Err.Clear

On Error GoTo 0

Else

temp.Activate

sh8.Activate

If ActiveSheet.FilterMode = True Then

ActiveSheet.ShowAllData

End If

lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

sh8.Range("A2:K" & 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

temp.Activate

Set sh9 = ActiveWorkbook.Sheet("Onshore Reassignment")

If Err.Number <> 0 Then

Err.Clear

On Error GoTo 0

Else

temp.Activate

sh9.Activate

If ActiveSheet.FilterMode = True Then

ActiveSheet.ShowAllData

End If

lRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

sh9.Range("A2:K" & lRow).Copy

wkb.Activate

w_c1.Activate

lrow1 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

lrow1 = lrow1 + 1

w_c2.Range("A" & lrow1).Activate

w_c2.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

End Sub