Excel VBA：从外部工作簿复制范围时出错 [英] Excel VBA: Error copying a range from external workbook

问题描述

我试图将一个单元格从一个封闭的工作簿复制到当前工作簿，但我总是得到错误1004.我使用的代码如下：

I'm trying to copy a range of cells from a closed Workbook to the current Workbook but I always get ERROR 1004. The code I'm using is as follows:

Sub Sheet2()
Dim Filt As String
Dim FilterIndex As Integer
Dim Title As String
Dim Multi As Boolean
Dim DataFile
Dim WBdata As Workbook

'I prompt the user to select the file to import
Filt = "Excel Workbook 2010 (*.xlsx),*.xlsx," & "Excel Workbook (*.xls), *.xls," & "All Files (*.*),*.*"
FilterIndex = 1
Title = "Select file to import"
Multi = False
DataFile = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=FilterIndex, Title:=Title, MultiSelect:=Multi)

If DataFile = False Then
    MsgBox "No file was selected"
End If

'Open the file selected by the user
Set WBdata = Workbooks.Open(DataFile)

'Get the data
WBdata.Activate
Sheets("Sheet1").Range(Cells(4, 1), Cells(4, 1).End(xlDown).Offset(-1, 0)).Copy _ ThisWorkbook.Sheets("Sheet2").Columns(1)
ThisWorkbook.Sheets("Sheet2").Activate
ThisWorkbook.Sheets("Sheet2").Columns(1).Select
Selection.EntireColumn.AutoFit

'Close and Select Cell (1,1)
WBdata.Close
ThisWorkbook.Sheets("Manager").Activate
ThisWorkbook.Sheets("Manager").Cells(1, 1).Select
End Sub

调试器停止在表格（Sheet1）范围（单元格（4,1），单元格（4,1）.End（xlDown）.Offset（-1,0））复制_ ThisWorkbook.Sheets（Sheet2）。Columns 1）。

我尝试了相同的语法在一个测试文件，它顺利，但我不能让它发生在实际文件。这是测试文件中的代码：

I tried the same syntax in a Test file and it went smooth but I cannot make it happen on the actual file. This is the code in the Test file:

Sheets("Sheet1").Range(Cells(1, 1), Cells(1, 1).End(xlDown).Offset(-1, 0)).Copy ThisWorkbook.Sheets("Sheet1").Columns(2)

推荐答案

Two things

1. 您可能希望在 MsgBox未选择文件后退出子以便代码不会在此行中给出错误如果说用户取消了对话框，则设置WBdata = Workbooks.Open（DataFile）？或处理 If 语句的 Else 部分中的代码，如下面的代码所示

1. You might want to exit the sub after MsgBox "No file was selected" so that the code doesn't give an error in this line Set WBdata = Workbooks.Open(DataFile) if say the user cancelled the dialog box? Or Handle the code in the Else part of the If Statement as shown in the code below

您遇到该错误，因为您没有完全限定单元格，例如参见。（DOT） $ c> Cells（1，1）

You are getting that error because you have not fully qualified the cells for example see the .(DOT) in Cells(1, 1) in the code below

（ UNTESTED ）

Sub Sheet2()
    Dim Filt As String, Title As String
    Dim FilterIndex As Integer
    Dim Multi As Boolean
    Dim DataFile
    Dim WBdata As Workbook, ws As Worksheet

    Filt = "Excel Workbook 2010 (*.xlsx),*.xlsx," & _
           "Excel Workbook (*.xls), *.xls," & _
           "All Files (*.*),*.*"
    FilterIndex = 1
    Title = "Select file to import"
    Multi = False
    DataFile = Application.GetOpenFilename(FileFilter:=Filt, _
                                           FilterIndex:=FilterIndex, _
                                           Title:=Title, _
                                           MultiSelect:=Multi)

    If DataFile = False Then
        MsgBox "No file was selected"
    Else
        'Open the file selected by the user
        Set WBdata = Workbooks.Open(DataFile)
        Set ws = WBdata.Sheets("Sheet2")

        'Get the data
        With ws
            .Range(.Cells(4, 1), .Cells(4, 1).End(xlDown).Offset(-1, 0)).Copy _
            ThisWorkbook.Sheets("Sheet2").Columns(1)
            ThisWorkbook.Sheets("Sheet2").Columns(1).EntireColumn.AutoFit

            'Close and Select Cell (1,1)
            WBdata.Close SaveChanges:=False
        End With
    End If
End Sub

这篇关于Excel VBA：从外部工作簿复制范围时出错的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！