如何从其他工作簿（excel）复制数据？

我已经有一个macros创build工作表和其他一些东西。 在创build表单之后，是否需要调用另一个将第二个excel（open）的数据复制到第一个活动的excel文件的macros。

首先我想复制到标题，但我无法得到这个工作 – 不断收到错误。

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 

哪里不对 ？

我真的想避免让“我的file.xls”活跃。

编辑：我不得不放弃，并将SheetData复制到目标文件作为新的工作表，才可以工作。 find并select多行

Answer 1

两年后（在Google上find这个，所以对其他人）…如上所述，你不需要select任何东西。 这三行：

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)

可以replace

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)

这应该绕过select错误。

Answer 2

最佳做法是打开源文件（如果您不想打扰，请使用虚假的可见状态）读取您的数据，然后closures它。

一个工作和干净的代码是可用的链接在下面：

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

Answer 3

如果不影响屏幕，您是否会乐意使“我的文件.xls”处于活动状态？ closures屏幕更新是实现这一目标的方法，它也具有性能改进（如果在切换工作表/工作簿时进行循环，则显着）。

执行此操作的命令是：

  Application.ScreenUpdating = False 

当你的macros完成时，不要忘记把它变回True 。

Answer 4

我不认为你需要select任何东西。 我打开了两个空白工作簿Book1和Book2，在Book2的Sheet1的范围（“A1”）中放置值“A”，并在即时窗口中提交以下代码 –

工作簿（2）.Worksheets（1）.Range（“A1”）。复制工作簿（1）.Worksheets（1）.Range（“A1”）

Book1的Sheet1中的范围（“A1”）现在包含“A”。

另外，考虑到在你的代码中你试图从ActiveWorkbook复制到“myfile.xls”，这个顺序似乎被颠倒了，因为Copy方法应该被应用到ActiveWorkbook中的一个范围，并且目标复制function）应该是“myfile.xls”中的适当范围。

Answer 5

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

我不想使用打开的function，因为它打开工作簿，这将是恼人的

以下是我在VBA中编写的代码。 任何改进或新的select是值得欢迎的。

代码：在这里，我将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