Run Time Error 9 - Subscript out if range

  • 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