如何從其他工作簿（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復制到目標文件作為新工作表，然后才能工作。 查找並選擇多行

Answer 1

最佳做法是打開源文件（如果您不想打擾，則顯示錯誤的可見狀態）讀取數據，然后關閉它。

下面的鏈接可以使用干凈利落的代碼：

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

Answer 2

兩年后（在Google上發現這個，對其他人也是如此）......如上所述，你不需要選擇任何東西。 這三行：

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 3

如果它不影響屏幕，你會樂意讓“my file.xls”處於活動狀態嗎？ 關閉屏幕更新是實現這一目標的方法，它還具有性能改進（如果您在切換工作表/工作簿時進行循環，則會很重要）。

執行此操作的命令是：

    Application.ScreenUpdating = False

當宏完成時，不要忘記將其恢復為True 。

Answer 4

我需要使用VBA將數據從一個工作簿復制到另一個工作簿。 要求如下所述1.按下Active X按鈕打開對話框，選擇需要復制數據的文件。 2.單擊“確定”后，應將值從單元格/范圍復制到當前工作的工作簿。

我不想使用open函數，因為它打開了煩人的工作簿

下面是我在VBA中編寫的代碼。 歡迎任何改進或新的替代方案。

代碼：這里我將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

Answer 5

我認為你根本不需要選擇任何東西。 我打開了兩個空白工作簿Book1和Book2，將值“A”放在Book2中Sheet1的Range（“A1”）中，並在即時窗口中提交以下代碼 -

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

Book1的Sheet1中的范圍（“A1”）現在包含“A”。

此外，鑒於您在代碼中嘗試從ActiveWorkbook復制到“myfile.xls”，因為Copy方法應該應用於ActiveWorkbook中的范圍和目標（參數為復制功能）應該是“myfile.xls”中的適當范圍。