代码无法正常工作

Question

我有 4 个连续运行的订阅者。第一个 sub 有 Calls 用于其他三个。我遇到了两个问题。

Copy_To_Template sub 完成了所有部分，除了，当我去的时候将数据复制到工作簿中，WGM 工作表是空的。数据已成功复制到其他工作表正确。
Filter_AGD sub 根本没有删除行。我会注意到我不确定 Filter_WGM 子是否正常工作，因为工作表中没有数据。 Filter_SWGM 按预期工作。

以下是全部4组代码：

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" & MANs.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" & MANs.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" & MANs.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

Sub Filter_WGM()
'

    Dim PTASK_Template As Workbook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim WGMd As Worksheet
        Set WGMd = PTASK_Template.Sheets("WGM")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


        With WGMd
        Dim LRMf As Long
            For LRMf = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
                If .Cells(LRMf, 3).Value <> "WorkGroup Manager" Then
                    .Rows(LRMf).Delete
                End If
            Next LRMf
        End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Sub Filter_SWGM()
'
    Dim PTASK_Template As Workbook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim SWGMd As Worksheet
        Set SWGMd = PTASK_Template.Sheets("SWGM")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


        With SWGMd
        Dim LRSf As Long
            For LRSf = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
                If .Cells(LRSf, 3).Value <> "Secondary WorkGroup Manager" Then
                    .Rows(LRSf).Delete
                End If
            Next LRSf
        End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Sub Filter_AGD()
'        
    Dim PTASK_Template As Workbook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim AGDd As Worksheet
        Set AGDd = PTASK_Template.Sheets("WGM")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


        With AGDd
        Dim LRDf As Long
            For LRDf = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
                If .Cells(LRDf, 3).Value <> "Director / DL" Then
                    .Rows(LRDf).Delete
                End If
            Next LRDf
        End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

如果不是你上一条评论中概述的调试，我不会找到这个。感谢所有评论者让我们走到这一步。

您的 Filter_AGD sub 指向 WGM 工作表，并清除那里的数据...

Sub Filter_AGD()
'        
    Dim PTASK_Template As Workbook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim AGDd As Worksheet
        Set AGDd = PTASK_Template.Sheets("WGM")

应该是...

Sub Filter_AGD()
'        
    Dim PTASK_Template As Workbook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim AGDd As Worksheet
        Set AGDd = PTASK_Template.Sheets("AGD")

代码无法正常工作

Code not working correctly

excel

vba

excel-2013