打开工作簿时,object不支持此属性错误

时间:2018-02-05 09:19:29

标签: excel vba excel-vba

我有两本工作簿。 workbook1是我的目标工作簿(DWB),工作簿2是我的原始工作簿(OWB)。我的OWB在网络文件夹中。

我正在尝试将OWB的所有内容复制到DWB。

以下是我到目前为止尝试过的代码。但在下面的行中,我收到错误

  

对象不支持此属性

     

设置OWB = Workbooks.Open(文件名:=文件路径)

Sub Extract()
Dim DWB As Workbook
Dim OWB As Workbook
Dim path1 As String
Dim path2 As String
Dim filepath As String
Dim LastRow As Long
Dim i As Long
Dim Lastcol As Long
Dim header As String
Dim cell As Range

Set DWB = ThisWorkbook

path1 = DWB.Path
filepath = "\\cw.wan.com\root" & "\Loc\04_Infol\pivot.xlsx"
Set OWB = Workbooks.Open(Filename:=filepath)

LastRow = OWB.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Lastcol = OWB.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column

    For i = 1 To Lastcol
    header = OWB.Worksheets(1).cell(1, i).Value

        With DWB.Worksheets("T").Range("A4:Y4")
        Set cell = .Find(header, LookIn:=xlValues)
        End With

            If Not cell Is Nothing Then
            OWB.Worksheets(1).Range(Cells(2, i), Cells(LastRow, i)).Copy Destination:=DWB.Worksheets("T").Cells(5, cell.Column)
                Else
                'handle error
            End If
    Next i
    OWB.Close savechanges:=Fasle
End Sub

2 个答案:

答案 0 :(得分:1)

每当遇到这样的问题时,请尽量减少代码并隔离问题。因此,在您的情况下,最小的问题看起来像:

Option Explicit

Public Sub TestMe()
    Dim owb As Workbook
    Set owb = Workbooks.Open("C:\Users\Something\Desktop\MyFile.xlsm")
End Sub

尝试使这个最小的2班轮工作,然后你的问题将得到解决。这是Minimal, Complete, and Verifiable example背后的想法。

答案 1 :(得分:1)

已追踪并解决了错误

我仍然相信你可以充分理解和使用Range引用,以确保你正确引用正确的引用并减少输入

例如你可以编码:

With Workbooks.Open(Filename:=filepath) 'reference wanted workbook
    With .Worksheets(1) 'reference wanted worksheet of referenced workbook
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 
        Lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        For i = 1 To Lastcol
            header = .Cells(1, i).value

            Set cell = DWB.Worksheets("T").Range("A4:Y4").Find(header, LookIn:=xlValues, lookat:=xlWhole)
            If Not cell Is Nothing Then
                .Range(.Cells(2, i), .Cells(LastRow, i)).Copy Destination:=cell.Offset(1)
            Else
                'handle error
            End If
        Next i
    End With
    .Close savechanges:=False
End With

您还可以在其中查看Find()方法的建议最小参数显式设置,否则将使用上次调用的方法(甚至来自UI!)