动态范围选择对应于错误的工作簿

时间:2018-10-29 14:16:00

标签: excel vba excel-vba

我正在写一个小程序,将大约40个生产计划汇总到一个工作簿中。我下面列出的代码应该是找到一个工作簿,该工作簿的名称与所有日程表一样(用于日期的通配符),然后使用需要聚合的字段创建联合范围。但是,在建立并集范围时,即使该活动工作簿是有效的,所选内容也对应于我的“主计划”范围而不是该周的计划。这段代码是在主计划中按一个按钮运行的,这给了我这个问题,但是,如果我从单个计划中的vb控制台运行它,那么它将起作用。我不确定这是什么问题。

    Sub CP_Data()
    Dim WorkCenter, Process_Order, Mat_Num, Batch_In, Qty_Needed, Desc, MRP, 
    Union_Range As Range
    Dim lRow, lRow2 As Long
    Dim wb As Workbook
    Dim wbName As String
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    lRow2 = Cells(Rows.Count, 2).End(xlUp).Row



    Set WorkCenter = ActiveSheet.Range("F3", "F" & lRow)
    Set Process_Order = ActiveSheet.Range("K3", "K" & lRow)
    Set Mat_Num = ActiveSheet.Range("M3", "M" & lRow)
    Set Batch_In = ActiveSheet.Range("O3", "O" & lRow)
    Set Qty_Needed = ActiveSheet.Range("Q3", "Q" & lRow)
    Set Desc = ActiveSheet.Range("N3", "N" & lRow)
    Set MRP = ActiveSheet.Range("W3", "W" & lRow)


    WorkCenter.Copy
    Workbooks("Master_Schedule").Activate
    Range("A" & lRow2 + 1).PasteSpecial xlPasteValues

    wbName = "all schedules"

    For Each wb In Application.Workbooks

        If wb.Name Like wbName & "*" Then
            Windows(wb.Name).activate
            wb.Sheets("Paste").Columns.EntireColumn.Hidden = False
            wb.Sheets("Paste").Rows.EntireRow.Hidden = False
            Set WorkCenter = wb.Sheets("Paste").Range("F3", "F" & lRow)
            Set Process_Order = wb.Sheets("Paste").Range("K3", "K" & lRow)
            Set Mat_Num = wb.Sheets("Paste").Range("M3", "M" & lRow)
            Set Batch_In = wb.Sheets("Paste").Range("O3", "O" & lRow)
            Set Qty_Needed = wb.Sheets("Paste").Range("Q3", "Q" & lRow)
            Set Desc = wb.Sheets("Paste").Range("N3", "N" & lRow)
            Set MRP = wb.Sheets("Paste").Range("W3", "W" & lRow)

          Set Union_Range = Union(WorkCenter, Mat_Num, Process_Order, Desc, Batch_In, Qty_Needed, MRP)

           Union_Range.Copy

          Workbooks("Master_Schedule").Activate
          Range("A" & lRow2 + 1).PasteSpecial xlPasteValues
        Else

        End If

    Next   

    End Sub

0 个答案:

没有答案