Excel 在不同名称的工作簿之间复制

我正在尝试将值从一个打开的工作簿复制/粘贴到另一个工作簿。 两个工作簿都没有静态名称，因此没有名称一致性。 我的两个工作簿都将打开，并且将是唯一打开的文件

当我不知道文件名时，有人能帮我修复这个代码吗

Range("M7:R19").Select
Selection.Copy
Windows("new template.xlsm").Activate
Range("M7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("old template.xlsm").Activate
Range("S7:AT16").Select
Application.CutCopyMode = False
Selection.Copy
Windows("new template.xlsm").Activate
Range("U7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

---

您必须创建两个

工作簿

变量，以区分要从复制的变量和要粘贴到的变量。因此，让您开始的是（因为只有这两本工作簿在运行时打开）：

第二部分代码是供你考虑的。我不知道您在这两个工作簿中所指的是哪一页，也不知道您是否真的需要复制/粘贴。在我的示例中，我使用了索引为

1

的

工作表

，我假设一个简单的

值

传输可能就是您真正想要的

---

但是最后两件事是要考虑的。

< P>你必须创建两个<代码>工作簿< /Cord>变量，以在你想要复制<强> > <强> >和你想粘贴<强>到< /强>之间。因此，让您开始的是（因为只有这两本工作簿在运行时打开）：

第二部分代码是供你考虑的。我不知道您在这两个工作簿中所指的是哪一页，也不知道您是否真的需要复制/粘贴。在我的示例中，我使用了索引为

1

的

工作表

，我假设一个简单的

值

传输可能就是您真正想要的

---

<>但是最后两件事是你要考虑的。

< P>使用< <代码> > < /Cult>运算符的替代方法来测试源/目的工作簿。还提供了一种定义源/目标范围的方法，这些范围可以循环使用，以便以后调试和更新。为了清晰起见，代码被大量注释

Sub tgr()

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet

    'Check if exactly 2 workbooks are currently open
    If Application.Workbooks.Count <> 2 Then
        MsgBox "ERROR - There are [" & Application.Workbooks.Count & "] workbooks open." & Chr(10) & _
               "There must be two workbooks open:" & Chr(10) & _
               "-The source workbook (old template)" & Chr(10) & _
               "-The destination workbook"
        Exit Sub
    End If

    For Each wb In Application.Workbooks
        If wb.Name Like "*#.xls?" Then
            'Workbook name ends in number(s), this is the source workbook that will be copied from
            'You'll need to specify which sheet you're working with, this example code assumes the activesheet of that workbook
            Set wsSource = wb.ActiveSheet
        Else
            'Workbook name does not end in number(s), this is the source workbook that will be pasted to
            'You'll need to specify which sheet you're working with, this example code assumes the activesheet of that workbook
            Set wsDest = wb.ActiveSheet
        End If
    Next wb

    'Check if both a source and destination were assigned
    If wsSource Is Nothing Then
        MsgBox "ERROR - Unable to find valid source workbook to copy data from"
        Exit Sub
    ElseIf wsDest Is Nothing Then
        MsgBox "ERROR - Unable to find valid destination workbook to paste data into"
        Exit Sub
    End If

    'The first dimension is for how many times you need to define source and dest ranges, the second dimension should always be 1 to 2
    Dim aFromTo(1 To 2, 1 To 2) As Range
    'Add source copy ranges here:                       'Add destination paste ranges here
    Set aFromTo(1, 1) = wsSource.Range("M7:R19"):       Set aFromTo(1, 2) = wsDest.Range("M7")
    Set aFromTo(2, 1) = wsSource.Range("S7:AT16"):      Set aFromTo(2, 2) = wsDest.Range("U7")
    'Set aFromTo(3, 1) = wsSource.Range("M21:R33"):      Set aFromTo(3, 2) = wsDest.Range("M21")    'Example of a third copy/paste range - Dim aFromTo(1 to 3, 1 to 2)
    'Set aFromTo(4, 1) = wsSource.Range("S21:AT30"):     Set aFromTo(4, 2) = wsDest.Range("U21")    'Example of a fourth copy/paste range - Dim aFromTo(1 to 4, 1 to 2)

    'This will loop through the array of specified FromTo ranges and will ensure that only values are brought over
    Dim i As Long
    For i = LBound(aFromTo, 1) To UBound(aFromTo, 1)
        aFromTo(i, 2).Resize(aFromTo(i, 1).Rows.Count, aFromTo(i, 1).Columns.Count).Value = aFromTo(i, 1).Value
    Next i

End Sub

Sub-tgr（）
将wb设置为工作簿
将wsSource设置为工作表
将wsDest设置为工作表
'检查当前是否正好打开了两个工作簿
如果Application.Workbooks.Count为2，则
MsgBox“错误-有[”&Application.Workbooks.Count&“]个工作簿打开。”&Chr（10）和_
必须打开两个工作簿：&Chr（10）和_
“-源工作簿（旧模板）”&Chr（10）和_
“-目标工作簿”
出口接头
如果结束
对于应用程序中的每个wb。工作簿
如果wb.Name像“*#.xls？”那么
'工作簿名称以数字结尾，这是将从中复制的源工作簿
'您需要指定正在使用的工作表，此示例代码假定该工作簿的活动工作表
设置wsSource=wb.ActiveSheet
其他的
'工作簿名称不以数字结尾，这是将粘贴到的源工作簿
'您需要指定正在使用的工作表，此示例代码假定该工作簿的活动工作表
设置wsDest=wb.ActiveSheet
如果结束
下一个wb
'检查是否同时分配了源和目标
如果wsSource什么都不是，那么
MsgBox“错误-找不到要从中复制数据的有效源工作簿”
出口接头
否则就什么都不是了
MsgBox“错误-找不到要将数据粘贴到的有效目标工作簿”
出口接头
如果结束
'第一个维度表示需要定义源和目标范围的次数，第二个维度应始终为1到2
调宽aFromTo（1到2，1到2）作为范围
'在此处添加源复制范围：'在此处添加目标粘贴范围
Set aFromTo（1，1）=wsSource.Range（“M7:R19”）：Set aFromTo（1，2）=wsDest.Range（“M7”）
设置aFromTo（2,1）=wsSource.Range（“S7:AT16”）：设置aFromTo（2,2）=wsDest.Range（“U7”）
'设置aFromTo（3，1）=wsSource.Range（“M21:R33”）：设置aFromTo（3，2）=wsDest.Range（“M21”）'第三个复制/粘贴范围的示例-Dim aFromTo（1到3，1到2）
'设置aFromTo（4，1）=wsSource.Range（“S21:AT30”）：设置aFromTo（4，2）=wsDest.Range（“U21”）'第四个复制/粘贴范围的示例-Dim aFromTo（1到4，1到2）
'这将在指定的FromTo范围的数组中循环，并将确保只传递值
我想我会坚持多久
对于i=LBound（aFromTo，1）到UBound（aFromTo，1）
aFromTo（i，2）.Resize（aFromTo（i，1）.Rows.Count，aFromTo（i，1）.Columns.Count）.Value=aFromTo（i，1）.Value
接下来我
端接头

使用

类似的

操作符测试源/目标工作簿的替代方法。还提供了一种定义源/目标范围的方法，这些范围可以循环使用，以便以后调试和更新。为了清晰起见，代码被大量注释

Sub tgr()

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet

    'Check if exactly 2 workbooks are currently open
    If Application.Workbooks.Count <> 2 Then
        MsgBox "ERROR - There are [" & Application.Workbooks.Count & "] workbooks open." & Chr(10) & _
               "There must be two workbooks open:" & Chr(10) & _
               "-The source workbook (old template)" & Chr(10) & _
               "-The destination workbook"
        Exit Sub
    End If

    For Each wb In Application.Workbooks
        If wb.Name Like "*#.xls?" Then
            'Workbook name ends in number(s), this is the source workbook that will be copied from
            'You'll need to specify which sheet you're working with, this example code assumes the activesheet of that workbook
            Set wsSource = wb.ActiveSheet
        Else
            'Workbook name does not end in number(s), this is the source workbook that will be pasted to
            'You'll need to specify which sheet you're working with, this example code assumes the activesheet of that workbook
            Set wsDest = wb.ActiveSheet
        End If
    Next wb

    'Check if both a source and destination were assigned
    If wsSource Is Nothing Then
        MsgBox "ERROR - Unable to find valid source workbook to copy data from"
        Exit Sub
    ElseIf wsDest Is Nothing Then
        MsgBox "ERROR - Unable to find valid destination workbook to paste data into"
        Exit Sub
    End If

    'The first dimension is for how many times you need to define source and dest ranges, the second dimension should always be 1 to 2
    Dim aFromTo(1 To 2, 1 To 2) As Range
    'Add source copy ranges here:                       'Add destination paste ranges here
    Set aFromTo(1, 1) = wsSource.Range("M7:R19"):       Set aFromTo(1, 2) = wsDest.Range("M7")
    Set aFromTo(2, 1) = wsSource.Range("S7:AT16"):      Set aFromTo(2, 2) = wsDest.Range("U7")
    'Set aFromTo(3, 1) = wsSource.Range("M21:R33"):      Set aFromTo(3, 2) = wsDest.Range("M21")    'Example of a third copy/paste range - Dim aFromTo(1 to 3, 1 to 2)
    'Set aFromTo(4, 1) = wsSource.Range("S21:AT30"):     Set aFromTo(4, 2) = wsDest.Range("U21")    'Example of a fourth copy/paste range - Dim aFromTo(1 to 4, 1 to 2)

    'This will loop through the array of specified FromTo ranges and will ensure that only values are brought over
    Dim i As Long
    For i = LBound(aFromTo, 1) To UBound(aFromTo, 1)
        aFromTo(i, 2).Resize(aFromTo(i, 1).Rows.Count, aFromTo(i, 1).Columns.Count).Value = aFromTo(i, 1).Value
    Next i

End Sub

Sub-tgr（）
将wb设置为工作簿
将wsSource设置为工作表
将wsDest设置为工作表
'检查当前是否正好打开了两个工作簿
如果Application.Workbooks.Count为2，则
MsgBox“错误-有[”&Application.Workbooks.Count&“]个工作簿打开。”&Chr（10）和_
必须打开两个工作簿：&Chr（10）和_
“-源工作簿（旧模板）”&Chr（10）和_
“-目标工作簿”
出口接头
如果结束
对于应用程序中的每个wb。工作簿
如果wb.Name像“*#.xls？”那么
'工作簿名称以数字结尾，这是将从中复制的源工作簿
'您需要指定正在使用的工作表，此示例代码假定该工作簿的活动工作表
设置wsSource=wb.ActiveSheet
其他的
'工作簿名称不以数字结尾，这是将粘贴到的源工作簿
'您需要指定正在使用的工作表，此示例代码假定该工作簿的活动工作表
设置wsDest=wb.ActiveSheet
如果结束