Question

我正在录制这个在几个不同文档之间传输数据的宏。其中一个工作簿＆＃34;传输模板＆＃34;保持不变。但另一个会改变。这是我正在使用的代码。（我知道它很慢并且很多都无关紧要，但我只需要让它工作）。

我所假设的是我必须用ActiveWorkbook或类似的东西替换Windows（＆＃34; RFQ_14446.xlsm＆＃34;）。

Sub Initial_Transfer_Macro()
'
' Initial_Transfer_Macro Macro
'

'
Windows("RFQ_14446.xlsm").Activate
Range("J51").Select
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B1").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("D27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B2").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B3").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B4").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("D7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B5").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("D18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B6").Select
ActiveSheet.Paste
Windows("RFQ_14446.xlsm").Activate
Range("K6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("D12").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("D22").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("D11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("K18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("K3").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("I13").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("I26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("C14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("I27").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("I5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "36"
Range("I5").Select
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("B20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("RFQ_14446.xlsm").Activate
Range("I26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer Template.xlsm").Activate
Range("C20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A1").Select
Cells.Replace What:=" Rev. ", Replacement:="-", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Cells.Replace What:="RFQ ", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

Answer 1

最简单的方法是在代码开头设置对每个工作簿的引用：

Sub SO()

Dim thisWorkbook  As Excel.Workbook
Dim otherWorkbook As Excel.Workbook

Set thisWorkbook = ActiveWorkbook
Set otherWorkbook = Workbooks("Transfer Template.xlsm")

'// ... Rest of code here

End Sub

完成此操作后，您可以改为引用该变量，例如：

Debug.Print thisWorkbook.Sheets.Count

或

otherWorkbook.Sheets(1).Range("A1").Value = thisWorkbook.Sheets(2).Range("B1").Value

只是粗略的例子，但应该给你逻辑的基础......

另一件值得注意的事情是，如果代码是从您想要引用的工作簿运行的，那么只需使用ThisWorkbook即可：

Sub Example()

Workbooks("Transfer Template.xlsm").Activate
MsgBox ActiveWorkbook.Name
MsgBox ThisWorkbook.Name

End Sub

Answer 2

如果您不知道工作簿名称，但它是同时打开的唯一一个（在同一个Excel实例中），您可以像这样循环遍历它们：

Sub TransferTemplate()
    Dim wbTemplate As Workbook: Set wbTemplate = ActiveWorkbook
    Dim wbDestination As Workbook

    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name <> wbTemplate.Name Then
            Set wbDestination = wb
        End If
    Next wb

    'Example copy
    wbTemplate.Worksheets(1).Range("B1").Value = wbDestination.Worksheets(1).Range("J51").Value
End Sub

如何在不使用其名称的情况下访问已打开的特定工作簿？

2 个答案: