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

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

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 2

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

下面的链接可以使用干净利落的代码：

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

Answer 3

如果不影响屏幕，您会很高兴“my file.xls”处于活动状态吗？关闭屏幕更新是实现这一目标的方法，它还具有性能改进（如果您在切换工作表/工作簿时进行循环，这一点很重要。）

执行此操作的命令是：

    Application.ScreenUpdating = False

当宏完成时，不要忘记将其转回True。

Answer 4

我认为你根本不需要选择任何东西。我打开了两个空白工作簿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”中的适当范围。

Answer 5

我需要使用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

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

5 个答案: