CODEWITHSUNDEEP
excelvba
s.amason
s.amason

Reputation: 1

How to stop reopening workbook?

I have this code.

Sub movedata()
    Dim i As Long

    Dim LastRow As Long
    Dim wb As Workbook
    Dim wb2 As Workbook

    Dim L1 As Variant, L2 As Variant, L3 As Variant, L4 As Variant,l6 as variant
     Variant, L6 As Variant, L7 As Variant, L8 As Variant

    Dim sht1 As Worksheet

    Set wb = ThisWorkbook
    Set sht1 = wb.Sheets("PKG Avail Days")
    LastRow = sht1.Range("D:O").Find("*", SearchDirection:=xlPrevious).Row

    For i = 5 To LastRow

        L1 = sht1.Range("D" & i).Value
        L2 = sht1.Range("E" & i).Value
        L3 = sht1.Range("F" & i).Value
        L4 = sht1.Range("K" & i).Value
        L5 = sht1.Range("L" & i).Value
        L6 = sht1.Range("M" & i).Value
        L7 = sht1.Range("N" & i).Value
        L8 = sht1.Range("O" & i).Value

        Set wb2 = Workbooks.Open("\\NMFPLPCLB130010\Users\stamarae\loglog.xlsx")

        wb2.Sheets(1).Range("D" & Rows.Count).End(xlUp).Offset(1, 0) = L1
        wb2.Sheets(1).Range("E" & Rows.Count).End(xlUp).Offset(1, 0) = L2
        wb2.Sheets(1).Range("F" & Rows.Count).End(xlUp).Offset(1, 0) = L3
        wb2.Sheets(1).Range("G" & Rows.Count).End(xlUp).Offset(1, 0) = L4
        wb2.Sheets(1).Range("H" & Rows.Count).End(xlUp).Offset(1, 0) = L5
        wb2.Sheets(1).Range("I" & Rows.Count).End(xlUp).Offset(1, 0) = L6
        wb2.Sheets(1).Range("J" & Rows.Count).End(xlUp).Offset(1, 0) = L7
        wb2.Sheets(1).Range("K" & Rows.Count).End(xlUp).Offset(1, 0) = L8

    Next i

End Sub

I get

Run-time Error '1004' - Method 'Open' of object 'Workbooks' failed.

and a prompting message

"xxxx" is already open. reopening will cause any changes you made to be discarded. do you want to reopen "xxx.xlsx?"

Upvotes: 0

Views: 462

Answers (3)

Steve Roberts
Steve Roberts

Reputation: 1

The following worked for me. The good thing is that no error condition was invoked:

MainCode:
    'sName = workbook.xlsm
    'sPathName = "c:\directory\structure\workbook.xlsm"
    'NEXTITEM is an emum with a value of 1

    If Not ItemCount(sName) Then
        Workbooks.Open (sPathName)
    end if

    '....

Function ItemCount(ByVal s As String) As Boolean

    Dim i As Integer

    ItemCount = False
    For i = NEXTITEM To Application.Workbooks.Count
        If Application.Workbooks.Item(i).Name = s Then
            ItemCount = True
        End If
    Next i

End Function

Upvotes: 0

DisplayName
DisplayName

Reputation: 13386

@Ryszard Jędraszyk told you the why of your issue

here's how you can simplify and speed up your code with no loops:

Sub movedata()
    Dim LastRow As Long            
    Dim sht2 As Worksheet

    Set sht2 = Workbooks.Open("\\NMFPLPCLB130010\Users\stamarae\loglog.xlsx").Sheets(1) ' set "destination" sheet as sheet 1 of the opened workbook 

    With ThisWorkbook.Sheets("PKG Avail Days") ' reference "source" sheet
        LastRow = .Range("D:O").Find("*", SearchDirection:=xlPrevious).Row

        With .Range("D:F").Rows("5:" & LastRow) ' reference referenced sheet columns D to F cells from row 5 down to 'LastRow'
            sht2.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count).Value = .Value ' paste referenced range values to "destination" sheet form column D first empty cell after last not empty one
        End With

        With .Range("K:O").Rows("5:" & LastRow) 
            sht2.Range("G" & Rows.Count).End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count).Value = .Value
        End With
    End With
End Sub

Upvotes: 1

Ryszard Jędraszyk
Ryszard Jędraszyk

Reputation: 2412

This is what happens when you put

Set wb2 = Workbooks.Open("\\NMFPLPCLB130010\Users\stamarae\loglog.xlsx")

within For i = 5 To LastRow Loop. Macro tries to open the same file for each row, without closing previous instance.

Upvotes: 2

Related Questions