如何從其他工作簿（excel）複製數據？

Question

我已經有了一個創建工作表和其他東西的宏。在創建工作表之後，是否需要調用另一個將第二個Excel（打開它）的數據複製到第一個和活動的Excel文件的宏。

首先我想複製到標題，但我不能得到那個工作 - 不斷得到錯誤。

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 

出什麼問題了？

我真的想避免讓「my file.xls」處於活動狀態。

編輯：我必須放棄它，然後將SheetData複製到目標文件作爲新工作表，然後才能工作。 Find and select multiple rows

Answer 1

如果「my file.xls」沒有影響屏幕，您是否會很高興？關閉屏幕更新是實現這一目標的方式，它還具有性能改進（如果您在切換工作表/工作簿時進行循環，則顯着）。

的命令來做到這一點：

Application.ScreenUpdating = False 

不要忘記當你的宏完成後把它回True。

Answer 2

我不認爲你需要選擇任何東西。我打開了兩個空白工作簿Book1和Book2，並在Book2的Sheet1的範圍（「A1」）中放置值「A」，並在立即窗口中提交了以下代碼：

Workbooks（2）.Worksheets（1） .Range（「A1」）。複製工作簿（1）.Worksheets（1）.Range（「A1」）

Book1的Sheet1中的範圍（「A1」）現在包含「A」。

另外，考慮到在您的代碼中，您試圖從ActiveWorkbook複製到「myfile.xls」，順序似乎顛倒了，因爲Copy方法應該應用於ActiveWorkbook中的範圍，而且目標（複製功能的參數）應該是「myfile.xls」中的適當範圍。

Answer 3

兩年後（在谷歌上找到這個，所以對其他人）......如上所述，你不需要選擇任何東西。這三條線：

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(Workbooks(File).Worksheets(SheetData). _
Range("A1"), Workbooks(File).Worksheets(SheetData).Range("A1").End(xlToRight)).Copy _
Destination:=ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

這種替代應避開選擇錯誤。

Answer 4

最佳做法是打開源文件（如果您不想打擾，請使用虛假可見狀態）讀取您的數據，然後關閉它。

一個工作和乾淨的代碼是下面的鏈接avalaible：

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

Answer 5

我需要從一個工作簿中的數據複製到另一個使用VBA的。要求如下所述1。按下Active X按鈕打開對話框以選擇需要複製數據的文件。 2.單擊確定後，該值應從單元格/範圍複製到當前正在工作的工作簿。

我不想使用開放的功能，因爲它打開，這將是惱人的

下面的工作簿的是，我在VBA編寫的代碼。任何改進或新的選擇是值得歡迎的。

代碼：我在這裏複製A1：從一個工作簿到A1 C4內容：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