对象不支持此属性或方法 从另一个工作簿复制时

Question

我正试图在Excel中编写一个小代码，让我在后台打开另一个工作簿，复制其中的一系列数据，然后将其粘贴到活动工作簿中。应该很直接，但由于某种原因，我犯了这个错误。到目前为止，我得到的是这个，我知道错误来自这行"；cpyLastRow=ImportBook.cpySheet.Cells(3，1(.End(xlDown(.Row"；，我评论了一些变量，让它在未来变得更有活力。有什么想法吗？

Private Sub CommandButton2_Click()
Dim OpenFile As Variant
Dim ImportBook As Workbook
Dim cpySheet As Worksheet
Dim cpyLastRow As Long
Dim cpyLastColumn As Long
'Dim cpyStartCell As Range
Set cpySheet = Sheets("DAO")
'Set cpyStartCell = Range("C3")
Application.ScreenUpdating = False
OpenFile = Application.GetOpenFilename(Title:="Select a file to import data", filefilter:="Excel Files (*.xls*),*xls*")
If OpenFile <> False Then
Set ImportBook = Application.Workbooks.Open(OpenFile)
cpyLastRow = ImportBook.cpySheet.Cells(3, 1).End(xlDown).Row
'cpyLastColumn = cpyStartCell.Column
ImportBook.cpySheet.Range("C3", cpySheet.Cells(cpyLastRow, 3)).Copy
ThisWorkbook.ActiveSheet.Range("C3").PasteSpecial xlPasteValues
ImportBook.Close False
End If
Application.ScreenUpdating = True
End Sub

Answer 1

由于混合了导入工作簿属性和活动工作簿表引用，您会收到一个错误。尝试使用方法1或方法2。请确保在导入工作簿中指定实际的工作表名称。

'get reference to sheet "ABF - DAO" in active workbook
Set cpySheet = Sheets("ABF - DAO") 
...
'error: mix workbook property and sheet reference
cpyLastRow = ImportBook.cpySheet.Cells(3, 1).End(xlDown).Row
'method 1: get reference to sheet in import workbook
Set cpySheet = ImportBook.Sheets("ABF - DAO")
cpyLastRow = cpySheet.Cells(3, 1).End(xlDown).Row
'method 2: get last row without sheet reference
cpyLastRow = ImportBook.Sheets("ABF - DAO")

Answer 2

从关闭的工作簿复制列范围

Option Explicit
Private Sub CommandButton2_Click()

Const ProcName As String = "CommandButton2_Click"
On Error GoTo clearError

Const sTitle As String = "Select a file to import data"
Const sFilter As String = "Excel Files (*.xls*),*xls*"
Const sName As String = "DAO"
Const sFirst As String = "C3"

Const dFirst As String = "C3"

Dim dSuccess As Boolean

' Source

' Path
Dim sPath As Variant
sPath = Application.GetOpenFilename(Title:=sTitle, FileFilter:=sFilter)

If sPath = False Then
MsgBox "You canceled.", vbExclamation, "Canceled"
GoTo ProcExit
End With

Application.ScreenUpdating = False

' Worksheet
Dim swb As Workbook: Set swb = Workbooks.Open(sPath)
On Error Resume Next
Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
On Error GoTo 0
If sws Is Nothing Then
CloseWithoutSaving swb
MsgBox "The worksheet '" & sName & "' does not exist.", _
vbCritical, "No Worksheet"
GoTo ProcExit
End If

' Range
Dim fCell As Range: Set fCell = sws.Range(sFirst)
With fCell

Dim lCell As Range
Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)

If lCell Is Nothing Then
CloseWithoutSaving swb
MsgBox "No data.", vbCritical, "No Data"
GoTo ProcExit
End If

Dim srg As Range: Set srg = .Resize(lCell.Row - .Row + 1)

End With

' Destination

' Assuming that the button is on the Destination Worksheet.
Dim dCell As Range: Set dCell = Range(dFirst)
' Otherwise, you should do something like this:
'Set dCell = ThisWorkbook.Worksheets("DAO").Range(dFirst)

' Copy (by Assignment)

dCell.Resize(srg.Rows.Count).Value = srg.Value
CloseWithoutSaving swb
dSuccess = True

ProcExit:

If Not Application.ScreenUpdating Then
Application.ScreenUpdating = True
End If

If dSuccess Then
MsgBox "Data transferred.", vbInformation, "Success"
End If

Exit Sub

clearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& "    " & "Run-time error '" & Err.Number & "':" & vbLf _
& "        " & Err.Description
Resume ProcExit
End Sub
Sub CloseWithoutSaving( _
ByVal wb As Workbook)
Application.DisplayAlerts = False
wb.Close False
Application.DisplayAlerts = True
End Sub