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

Excel sheet: Copy data from one workbook to another workbook

提问by Star

I am not able to copy data from one workbook to another. But with in same workbook its working. After running the macro program the destination worksheet is empty. I have 2 codes. Both are not working. My source file is .xlsxformat and destination file is .xlsmformat. Is there any mistakes?

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

Code1:

代码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

Code 2

代码 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

回答by Ajeet Shah

I assume that you are writing below Code1and Code2excel macros in a separate file, say copy_paste.xlsm:

我假设你正在编写如下代码1和代码2在一个单独的文件Excel宏，说copy_paste.xlsm：

Code 1is working when you provide a full path of files to Workbooks.open:

当您提供Workbooks.open文件的完整路径时，代码 1正在工作：

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

To paste everything (formulas + values + formats), use paste type as xlPasteAll.

要粘贴所有内容（公式 + 值 + 格式），请使用粘贴类型为xlPasteAll.

Code 2is working too, all you need is to provide full path and you are missing _in file names:

代码 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

回答by user3598756

editedto add a (minimum) file check

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

you must specify full file path, name and extension

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

more over you can open only destination file, like this

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

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"
            .Value = .Value
        End With

        y.Close SaveChanges:=True
    End If
End Sub

you could even open neither of them using Excel4macro

你甚至可以使用 Excel4macro 打开它们