【问题标题】:Amending a VBA so that it works between two workbooks as opposed to two worksheets修改 VBA 使其在两个工作簿之间工作,而不是在两个工作表之间工作
【发布时间】:2018-01-03 11:37:15
【问题描述】:

大家好,提前致谢。

当“O”列中的单元格具有特定值时,我目前在我的工作簿中有一个 VBA 可以将行从“需求日志”复制到“更改日志”。

VBA 运行良好,但我现在希望将这两个工作表分开,并为每个工作表设置一个单独的工作簿。

我的问题是 - 如何更改我的 VBA 以便它在工作簿之间而不是工作表之间复制和粘贴?

请在下面查看我的 VBA 代码:

Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Demand Log").UsedRange.Rows.Count
J = Worksheets("Change Log").Cells(Worksheets("Change Log").Rows.Count, "B").End(xlUp).Row
If J = 1 Then
   If Application.WorksheetFunction.CountA(Worksheets("Change Log").Range) = 0 Then J = 0
End If
Set xRg = Worksheets("Demand Log").Range("O5:O" & I)

Application.ScreenUpdating = False
For K = xRg.Count To 1 Step -1
    If CStr(xRg(K).Value) = "Change Team" Then
        J = J + 1
        With Worksheets("Demand Log")
            Intersect(.Rows(xRg(K).Row), .Range("A:Z")).Copy Destination:=Worksheets("Change Log").Range("A" & J)
            Intersect(.Rows(xRg(K).Row), .Range("A:Z")).Delete xlShiftUp
        End With
    End If
Next
Application.ScreenUpdating = True

【问题讨论】:

    标签: vba excel


    【解决方案1】:

    您应该同时参考您的工作表和工作簿。所以,而不是:

    I = Worksheets("Demand Log").UsedRange.Rows.Count
    

    你应该输入:

    I = Workbooks("Book1").Worksheets("Demand Log").UsedRange.Rows.Count
    

    代码中的任何位置。为简单起见,您可以设置对象变量,例如:

    Dim wb1 as Workbook
    Set wb1 = Application.Workbooks("Book1")
    

    或者,更好的是,将您的工作表设置为变量,例如:

    Dim wsDemand as Worksheet
    Set wsDemand = Workbooks("Book1").Worksheets("Demand Log")
    

    然后您可以在代码中的任何位置使用 wsDemand 而不是 Worksheets("Demand Log")。 Book1 当然是默认工作簿的名称,您的文件可能有其他名称。

    【讨论】:

      【解决方案2】:

      如果工作簿是打开的,那么您可以这样引用它: Workbooks("mybook.xls")[.method]

      如果工作簿已关闭,您需要打开它:Workbooks.Open("C:\path\mybook.xls")[.method]

      您可以将它们分配给变量:

      set wb = Workbooks("mybook.xls")
      set wb = Workbooks.Open("C:\path\mybook.xls")
      
      set ws = wb.Sheets("MySheet")
      

      您还可以访问工作表并将其分配给一个变量:(如果您使用的是单个工作表,则很有用)

      set ws = Workbooks("mybook.xls").Sheets("MySheet")
      set ws = Workbooks.Open("C:\path\mybook.xls").Sheets("MySheet")
      

      未经测试,但试一试:

      Sub mysub()
      
          Dim xRg As Range
          Dim xCell As Range
          Dim I As Long
          Dim J As Long
          Dim K As Long
      
          Dim wbDem As Workbook
          Dim wbChg As Workbook
          Dim wsDem As Worksheet
          Dim wsChg As Worksheet
      
      
          'Open/Get Workbook
          If Application.Workbooks("Demand.xls") Is Nothing Then
              Set wbDem = Application.Workbooks.Open("C:\path\Demand.xls")
          Else
              Set wbDem = Application.Workbooks("Demand.xls")
          End If
      
          'Open/Get Workbook
          If Application.Workbooks("Change") Is Nothing Then
              Set wbChg = Application.Workbooks.Open("C:\path\Change.xls")
          Else
              Set wbChg = Application.Workbooks("Change.xls")
          End If
      
          'Set Sheet Variables
          Set wsDem = wbDem.Worksheets("Demand Log")
          Set wsChg = wbChg.Worksheets("Change Log")
      
      
          I = wsDem.UsedRange.Rows.Count
          J = wsChg.Cells(wbChg.Rows.Count, "B").End(xlUp).Row
          If J = 1 Then
             If Application.WorksheetFunction.CountA(wbChg.Range) = 0 Then J = 0
          End If
          Set xRg = wsDem.Range("O5:O" & I)
      
          Application.ScreenUpdating = False
          For K = xRg.Count To 1 Step -1
              If CStr(xRg(K).value) = "Change Team" Then
                  J = J + 1
                  With wsDem
                      Intersect(.Rows(xRg(K).Row), .Range("A:Z")).Copy Destination:=wsChg.Range("A" & J)
                      Intersect(.Rows(xRg(K).Row), .Range("A:Z")).Delete xlShiftUp
                  End With
              End If
          Next
          Application.ScreenUpdating = True
      
      End Sub
      

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2020-07-17
        相关资源
        最近更新 更多