vba 如何从另一个工作簿（excel）复制数据？

How to copy data from another workbook (excel)?

提问by Kim

I already have a macro that creates sheets and some other stuff. After a sheet has been created do I want to call another macro that copies data from a second excel (its open) to first and active excel file.

我已经有一个创建工作表和其他一些东西的宏。创建工作表后，我是否想调用另一个宏将数据从第二个 excel（打开）复制到第一个和活动的 excel 文件。

First I want to copy to headers, but I cant get that to work - keep getting errors.

首先我想复制到标题，但我无法让它工作 - 不断出现错误。

Sub CopyData(sheetName as String)
  Dim File as String, SheetData as String

  File = "my file.xls"
  SheetData = "name of sheet where data is"

  # Copy headers to sheetName in main file
  Workbooks(File).Worksheets(SheetData).Range("A1").Select  # fails here: Method Select for class Range failed
  Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select
  Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1)
End Sub

What is wrong ?

怎么了 ？

I really want to avoid having to make "my file.xls" active.

我真的很想避免激活“我的 file.xls”。

Edit: I had to give it up and copy the SheetData to target file as a new sheet, before it could work. Find and select multiple rows

编辑：我不得不放弃它并将 SheetData 作为新工作表复制到目标文件，然后才能工作。 查找并选择多行

回答by Iain Wareing

Two years later (Found this on Google, so for anyone else)... As has been mentioned above, you don't need to select anything. These three lines:

两年后（在谷歌上找到了这个，其他人也是如此）......如上所述，你不需要选择任何东西。这三行：

Workbooks(File).Worksheets(SheetData).Range("A1").Select
Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select
Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

Workbooks(File).Worksheets(SheetData).Range("A1").Select
Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select
Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

Can be replaced with

可以换成

Workbooks(File).Worksheets(SheetData).Range(Workbooks(File).Worksheets(SheetData). _
Range("A1"), Workbooks(File).Worksheets(SheetData).Range("A1").End(xlToRight)).Copy _
Destination:=ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

Workbooks(File).Worksheets(SheetData).Range(Workbooks(File).Worksheets(SheetData). _
Range("A1"), Workbooks(File).Worksheets(SheetData).Range("A1").End(xlToRight)).Copy _
Destination:=ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

This should get around the select error.

这应该可以解决选择错误。

回答by user3188123

Best practice is to open the source file (with a false visible status if you don't want to be bother) read your data and then we close it.

最佳做法是打开源文件（如果您不想打扰，则使用错误的可见状态）读取您的数据，然后我们将其关闭。

A working and clean code is avalaible on the link below :

以下链接提供了一个有效且干净的代码：

http://vba-useful.blogspot.fr/2013/12/how-do-i-retrieve-data-from-another.html

http://vba-useful.blogspot.fr/2013/12/how-do-i-retrieve-data-from-another.html

回答by Sam Meldrum

Would you be happy to make "my file.xls" active if it didn't affect the screen? Turning off screen updating is the way to achieve this, it also has performance improvements (significant if you are doing looping while switching around worksheets / workbooks).

如果“我的文件.xls”不影响屏幕，您是否乐意激活它？关闭屏幕更新是实现此目的的方法，它还具有性能改进（如果您在切换工作表/工作簿时进行循环，则意义重大）。

The command to do this is:

执行此操作的命令是：

    Application.ScreenUpdating = False

Don't forget to turn it back to Truewhen your macros is finished.

不要忘记True在宏完成后将其转回。

回答by Anindya

I don't think you need to select anything at all. I opened two blank workbooks Book1 and Book2, put the value "A" in Range("A1") of Sheet1 in Book2, and submitted the following code in the immediate window -

我认为您根本不需要选择任何东西。我打开两个空白工作簿Book1和Book2，将值“A”放入Book2的Sheet1的Range("A1")中，并在即时窗口中提交以下代码-

Workbooks(2).Worksheets(1).Range("A1").Copy Workbooks(1).Worksheets(1).Range("A1")

工作簿(2).工作表(1).Range("A1").复制工作簿(1).工作表(1).Range("A1")

The Range("A1") in Sheet1 of Book1 now contains "A".

Book1 的 Sheet1 中的 Range("A1") 现在包含 "A"。

Also, given the fact that in your code you are trying to copy from the ActiveWorkbook to "myfile.xls", the order seems to be reversed as the Copy method should be applied to a range in the ActiveWorkbook, and the destination (argument to the Copy function) should be the appropriate range in "myfile.xls".

此外，考虑到在您的代码中您试图从 ActiveWorkbook 复制到“myfile.xls”，顺序似乎被颠倒了，因为 Copy 方法应该应用于 ActiveWorkbook 中的范围和目标（参数为Copy 函数）应该是“myfile.xls”中的适当范围。

回答by cSharpDirective

I was in need of copying the data from one workbook to another using VBA. The requirement was as mentioned below 1. On pressing an Active X button open the dialogue to select the file from which the data needs to be copied. 2. On clicking OK the value should get copied from a cell / range to currently working workbook.

我需要使用 VBA 将数据从一个工作簿复制到另一个工作簿。要求如下所述 1. 按 Active X 按钮打开对话框以选择需要从中复制数据的文件。2. 单击确定后，值应该从单元格/范围复制到当前工作的工作簿。

I did not want to use the open function because it opens the workbook which will be annoying

我不想使用 open 功能，因为它会打开工作簿，这会很烦人

Below is the code that I wrote in the VBA. Any improvement or new alternative is welcome.

下面是我在 VBA 中编写的代码。欢迎任何改进或新的替代方案。

Code: Here I am copying the A1:C4 content from a workbook to the A1:C4 of current workbook

代码：这里我将 A1:C4 内容从工作簿复制到当前工作簿的 A1:C4

    Private Sub CommandButton1_Click()
        Dim BackUp As String
        Dim cellCollection As New Collection
        Dim strSourceSheetName As String
        Dim strDestinationSheetName As String
        strSourceSheetName = "Sheet1" 'Mention the Source Sheet Name of Source Workbook
        strDestinationSheetName = "Sheet2" 'Mention the Destination Sheet Name of Destination Workbook


        Set cellCollection = GetCellsFromRange("A1:C4") 'Mention the Range you want to copy data from Source Workbook

        With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = False
            .Show
            '.Filters.Add "Macro Enabled Xl", "*.xlsm;", 1

            For intWorkBookCount = 1 To .SelectedItems.Count
                Dim strWorkBookName As String
                strWorkBookName = .SelectedItems(intWorkBookCount)
                For cellCount = 1 To cellCollection.Count
                    On Error GoTo ErrorHandler
                    BackUp = Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount))
                    Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = GetData(strWorkBookName, strSourceSheetName, cellCollection.Item(cellCount))
                    Dim strTempValue As String
                    strTempValue = Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)).Value
                    If (strTempValue = "0") Then
                        strTempValue = BackUp
                    End If
Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = strTempValue 
ErrorHandler:
                    If (Err.Number <> 0) Then
                            Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = BackUp
                        Exit For
                    End If
                Next cellCount
            Next intWorkBookCount
        End With

    End Sub

    Function GetCellsFromRange(RangeInScope As String) As Collection
        Dim startCell As String
        Dim endCell As String
        Dim intStartColumn As Integer
        Dim intEndColumn As Integer
        Dim intStartRow As Integer
        Dim intEndRow As Integer
        Dim coll As New Collection

        startCell = Left(RangeInScope, InStr(RangeInScope, ":") - 1)
        endCell = Right(RangeInScope, Len(RangeInScope) - InStr(RangeInScope, ":"))
        intStartColumn = Range(startCell).Column
        intEndColumn = Range(endCell).Column
        intStartRow = Range(startCell).Row
        intEndRow = Range(endCell).Row

        For lngColumnCount = intStartColumn To intEndColumn
            For lngRowCount = intStartRow To intEndRow
                coll.Add (Cells(lngRowCount, lngColumnCount).Address(RowAbsolute:=False, ColumnAbsolute:=False))
            Next lngRowCount
        Next lngColumnCount

        Set GetCellsFromRange = coll
    End Function

    Function GetData(FileFullPath As String, SheetName As String, CellInScope As String) As String
        Dim Path As String
        Dim FileName As String
        Dim strFinalValue As String
        Dim doesSheetExist As Boolean

        Path = FileFullPath
        Path = StrReverse(Path)
        FileName = StrReverse(Left(Path, InStr(Path, "\") - 1))
        Path = StrReverse(Right(Path, Len(Path) - InStr(Path, "\") + 1))

        strFinalValue = "='" & Path & "[" & FileName & "]" & SheetName & "'!" & CellInScope
        GetData = strFinalValue
    End Function