CODEWITHSUNDEEP
vbaexcel
Mikz
Mikz

Reputation: 591

object doesnot support this property error while opening a workbook

I have two workbooks. workbook1 is my destination workbook(DWB) and workbook 2 is my original workbook (OWB). My OWB is in the network folder.

I am trying to copy all the contents of OWB to DWB.

Below is my code I have tried so far. But in the line below, I get a error

object doesnot support this property

Set OWB = Workbooks.Open(Filename:=filepath)

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

Upvotes: 0

Views: 106

Answers (2)

DisplayName
DisplayName

Reputation: 13386

The error has been tracked down and solved

Still I believe you could take advantage from thorough understanding and usage of Range references to both ensure you're correctly referencing the correct one and reduce typing, too

for instance you could code:

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

where you can also see the recommended minimum parameter explicit setting of Find() method, which otherwise would use those from its last call (even from UI!)

Upvotes: 1

Vityata
Vityata

Reputation: 43593

Whenever you have some problem like this, try to minimze the code and isolate the problem. Thus, in your case, the minimal problem would look like:

Option Explicit

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

Try to make this minimal 2 liner work, then your problem will be fixed. This is the idea behind the Minimal, Complete, and Verifiable example.

Upvotes: 1

Related Questions