Excel表格：将数据从一个工作簿复制到另一个工作簿

Question

我无法将数据从一个工作簿复制到另一个工作簿。但在同一个工作簿中可以正常运行。运行宏程序后，目标工作表为空。我有两个代码。都不起作用。我的源文件是.xlsx格式，目标文件是.xlsm格式。是否有错误？

代码1：

Sub mycode()

Workbooks.Open Filename:="source_file"
Worksheets("Sheet1").Cells.Select
Selection.Copy


Workbooks.Open Filename:="destination_file"
Worksheets("Sheet1").Cells.Select
Selection.PasteSpecial
ActiveWorkbook.Save


End Sub

代码 2

Sub foo2()
Dim x As Workbook
Dim y As Workbook

Set x = Workbooks.Open("source file")
Set y = Workbooks.Open("destination file")

y.Sheets("Sheet1").Range("A1").Value = x.Sheets("Sheet1").Range("A1")

x.Close

End Sub

- Star

Answer 1

编辑以添加（最小）文件检查

必须指定完整的文件路径、名称和扩展名

此外，您只能打开目标文件，像这样

Option Explicit

Sub foo2()
    Dim y As Workbook
    Dim sourcePath As String, sourceFile As String, destFullPath As String '<--| not necessary, but useful not to clutter statements

    sourcePath = "C:\Users\xyz\Documents\Excel-Problem\" '<--| specify your source file path down to the last backslash and with no source file name
    sourceFile = "source_file.xlsx" '<--| specify your source file name only, with its extension
    destFullPath = "C:\Users\xyz\Documents\Excel-Problem\destination_file.xlsm" '<--| specify your destination file FULL path

    If Dir(destFullPath) = "" Then '<--| check is such a file actually exists
        MsgBox "File " & vbCrLf & vbCrLf & destFullPath & vbCrLf & vbCrLf & "is not there!" & vbCrLf & vbCrLf & vbCrLf & "The macro stops!", vbCritical
    Else
        Set y = Workbooks.Open(destFullPath)

        With y.Sheets("Sheet1").Range("A1")
            .Formula = "='" & sourcePath & "[" & sourceFile & "]Sheet1'!$A$1"
            .Value = .Value
        End With

        y.Close SaveChanges:=True
    End If
End Sub

你甚至可以使用Excel4macro打开它们中的任何一个。

- user3598756

---

编辑以添加文件检查。您是否有任何 On Error Resume Next 或 On Error GoTo 语句？ - user3598756

Answer 2

我假设您是在一个单独的文件中编写以下的Excel宏代码Code1和Code2，例如copy_paste.xlsm：

Code 1会在您提供文件的完整路径Workbooks.open时运行：

Sub mycode()

Workbooks.Open Filename:="C:\Users\xyz\Documents\Excel-Problem\source_file.xlsx"
Worksheets("Sheet1").Cells.Select
Selection.Copy

Workbooks.Open Filename:="C:\Users\xyz\Documents\Excel-Problem\destination_file.xlsm"
Worksheets("Sheet1").Cells.Select
Selection.PasteSpecial xlPasteValues               'xlPasteAll to paste everything
ActiveWorkbook.Save

ActiveWorkbook.Close SaveChanges:=True             'to close the file
Workbooks("source_file").Close SaveChanges:=False  'to close the file

End Sub

如果想要复制所有内容（包括公式+数值+格式），请使用粘贴类型xlPasteAll。

代码2也可以工作，只需要提供完整路径并且在文件名中添加_：

Sub foo2()
Dim x As Workbook
Dim y As Workbook

Set x = Workbooks.Open("C:\Users\xyz\Documents\Excel-Problem\source_file.xlsx")
Set y = Workbooks.Open("C:\Users\xyz\Documents\Excel-Problem\destination_file.xlsm")

'it copies only Range("A1") i.e. single cell
y.Sheets("Sheet1").Range("A1").Value = x.Sheets("Sheet1").Range("A1")

x.Close SaveChanges:=False
y.Close SaveChanges:=True

End Sub

- Ajeet Shah

---

谢谢。我只给了完整路径，为了参考我提到了源文件。我尝试了你的代码，但它没有工作。在打开第二个文件后调试时，调试器没有进入下一行，而是停止了调试本身。 - Star

第二个文件是一个启用宏的文件，所以在你手动打开它时是否有任何宏在其中运行？ - Ajeet Shah

代码没有显示任何错误信息。代码运行正常，但是当我打开目标文件时，发现里面没有复制任何内容。调试器也没有显示任何错误信息。 当代码执行到“Workbooks.Open Filename:=”C:\Users\xyz\Documents\Excel-Problem\destination_file”这一行时，突然停止工作。 - Star

你的文件似乎存在一些问题。文件大小？第二个文件是一个空的启用宏的文件吗？我猜测第二个文件中有一些宏导致了你的问题，你应该检查一下这些宏。 - Ajeet Shah

它是启用宏的文件。除此之外没有其他宏。 - Star