RT 1004 - 方法'范围'对象' _Worksheet'失败

时间:2016-05-10 17:58:41

标签: excel-vba excel-2013 vba excel

我在这一行收到RT 1004 - Method 'Range' of object '_Worksheet' failed错误:LRWGM = MANs.Range("A" & Rows.Count).End(xlUp).Row来自下面的代码。不知道为什么。有什么想法吗?以下是完整代码:

Sub Copy_To_Template()
'
    ' The following is a list of the Source Workbooks and Worksheets

    Dim PRM1 As Workbook ' source workbook 1 contains current list of unassigned Problem Tasks
        Set PRM1 = Workbooks("BCRS-PTASKS Unassigned.csv")
    Dim PRM2 As Workbook ' source WorkBook 2 contains all assignment group information
        Set PRM2 = Workbooks("Problem WGM & WGL xref with description.xls")
    Dim PTASKS_Unassigned As Worksheet ' source WorkSheet
        Set PTASKS_Unassigned = PRM1.Sheets("BCRS-PTASKS Unassigned")
    Dim MANs As Worksheet
        Set MANs = PRM2.Sheets("Page 1")

    ' The following is a list of all the Destination workbooks and worksheets

    Dim PTASK_Template As Workbook ' destination WorkBook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim PTASK As Worksheet
        Set PTASK = PTASK_Template.Sheets("BCRS Unassigned Tasks")
    Dim WGMd As Worksheet
        Set WGMd = PTASK_Template.Sheets("WGM")
    Dim SWGMd As Worksheet
        Set SWGMd = PTASK_Template.Sheets("SWGM")
    Dim AGDd As Worksheet
        Set AGDd = PTASK_Template.Sheets("AGD")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Copy Unassigned Tasks

    Dim LRUPT As Long
    LRUPT = PTASKS_Unassigned.Range("A" & Rows.Count).End(xlUp).Row
    Dim UPTRow As Long
    UPTRow = PTASK.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    PTASKS_Unassigned.Range("A2:F" & LRUPT).Copy PTASK.Range("A" & UPTRow)

    PTASK.Range("A:A,B:B,C:C,D:D,E:E,F:F").Columns.AutoFit
    PTASK.Cells.WrapText = False

    ' Copy to WGM

    Dim LRWGM As Long
    LRWGM = MANs.Range("A" & Rows.Count).End(xlUp).Row
    Dim WGMRow As Long
    WGMRow = WGMd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    MANs.Range("A2:E" & LRWGM).Copy WGMd.Range("A" & WGMRow)

    WGMd.Range("A:A,B:B,C:C,D:D,E:E").Columns.AutoFit
    WGMd.Cells.WrapText = False

    ' Copy to SWGM

    Dim LRSWGM As Long
    LRSWGM = MANs.Range("A" & Rows.Count).End(xlUp).Row
    Dim SWGMRow As Long
    SWGMRow = SWGMd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    MANs.Range("A2:E" & LRSWGM).Copy SWGMd.Range("A" & SWGMRow)

    SWGMd.Range("A:A,B:B,C:C,D:D,E:E").Columns.AutoFit
    SWGMd.Cells.WrapText = False

    ' Copy to AGD

    Dim LRAGD As Long
    LRAGD = MANs.Range("A" & Rows.Count).End(xlUp).Row
    Dim AGDRow As Long
    AGDRow = AGDd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    MANs.Range("A2:E" & LRAGD).Copy AGDd.Range("A" & AGDRow)

    AGDd.Range("A:A,B:B,C:C,D:D,E:E").Columns.AutoFit
    AGDd.Cells.WrapText = False

    Dim WB1 As Workbook
        Set WB1 = Workbooks("BCRS-PTASKS Unassigned.csv")

    Dim WB2 As Workbook
        Set WB2 = Workbooks("Problem WGM & WGL xref with description.xls")

    WB1.Close False
    WB2.Close False

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    Call Filter_WGM
    Call Filter_SWGM
    Call Filter_AGD

End Sub

0 个答案:

没有答案