Open another workbook & copy worksheet using cell value as reference

[Emeng]

Hi all
I would like to open another workbook & retrieve a worksheet equal to a cell value using VBA.
I have two codes which each do part of the job but I’m having trouble stitching them together.
The following code opens the workbook & retrieves the sheet but requires the specific file name, however the file name changes each time the parent file is accessed -

Sub OpenWorkbookCopySheet()
Dim wb As Workbook
Dim activeWB As Workbook
Dim FilePath As String
Dim oWS      As String
Set activeWB = Application.ActiveWorkbook
FilePath = "C:\Users\15309mng\Documentum\Viewed\Labour report 2013_4.xlsx"
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    oWS = Sheets(1).Range("A1").Value
    Set wb = Application.Workbooks.Open(FilePath)
    wb.Worksheets(oWS).Copy After:=activeWB.Sheets(activeWB.Sheets.Count)
    activeWB.Activate
    wb.Close False
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
End Sub

The next code opens the latest version of the relevant file but will not import the required worksheet with the code copied from above.

Sub OpenLatestFile()
    Dim wb As Workbook
    Dim activeWB As Workbook
    Dim oWS      As String
 
    Dim MyPath  As String
    Dim MyFile  As String
    Dim LatestFile  As String
    Dim LatestDate  As Date
    Dim LMD  As Date
        Set activeWB = Application.ActiveWorkbook
   
    MyPath = "C:\Users\15309mng\Documentum\Viewed\"
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
 
    MyFile = Dir(MyPath & "Labour report*.xlsx", vbNormal)
 
    If Len(MyFile) = 0 Then
        MsgBox "No files were found...", vbExclamation
        Exit Sub
    End If
 
    Do While Len(MyFile) > 0
        LMD = FileDateTime(MyPath & MyFile)
        If LMD > LatestDate Then
            LatestFile = MyFile
            LatestDate = LMD
        End If
        MyFile = Dir
       
    Loop
 
    Workbooks.Open MyPath & LatestFile
End Sub

I tried adding the following code - after 'Workbooks.Open MyPath & LatestFile' - along with the variables from/to the above to copy the relevant sheet but trips at the second line –

  oWS = Sheets(1).Range("A1").Value
  wb.Worksheets(oWS).Copy After:=activeWB.Sheets(activeWB.Sheets.Count)
  activeWB.Activate
  wb.Close False

"Run-time error “91”
Object variable or With block variable not set."

I have also tried (the code button has stopped working?)

With MyFile
.Worksheets(oWS).Copy After:=activeWB.Sheets(activeWB.Sheets.Count)
End With

As well as

With MyFile
wb..Worksheets(oWS).Copy After:=activeWB.Sheets(activeWB.Sheets.Count)
End With

Both of these produce the following error –
"Compile error:
With object must be user-defined type, Object or Variant"

& also tried

With wb
.Worksheets(oWS).Copy After:=activeWB.Sheets(activeWB.Sheets.Count

Which causes a "Run-time Automation error."

I am sure the solution is fairly straightforward & equally sure it will be a long time before I manage to work it out.

Any help is much appreciated.

With thanks,
Mark

 

[Deepak]

Hi,

I just checked & find this working.

Option Explicit

Sub OpenLatestFile()
    Dim activeWB As Workbook
    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Variant
    Dim LMD As Variant
   
    Set activeWB = Application.ActiveWorkbook
        MyPath = "C:\Users\Deepak\Desktop\New Folder\" 'Rechek the same
            If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
                MyFile = Dir(MyPath & "ABC*.*")
                    If Len(MyFile) = 0 Then
                        MsgBox "No files were found...", vbExclamation
                    Exit Sub
                    End If
    Do While Len(MyFile) > 0
        LMD = FileDateTime(MyPath & MyFile)
            If LMD > LatestDate Then
                LatestFile = MyFile
                LatestDate = LMD
            End If
        MyFile = Dir
    Loop
    Workbooks.Open MyPath & LatestFile
End Sub

 

[Emeng]

Hi dEEPAK

Sub OpenLatestFile() works well for opening the latest version of a file.

http://answers.microsoft.com/en-us/...n-folder/a23cfed4-944a-e011-8dfc-68b599b31bf5 Thank you to Raph.B.

I would like to add some extra code which will then copy a worksheet to the original workbook based on a cell value in the original workbook.
I have used the copying code from Sub OpenWorkbookCopySheet(), which also works well, but has limitations.

    oWS = Sheets(1).Range("A1").Value
    Set wb = Application.Workbooks.Open(FilePath)
    wb.Worksheets(oWS).Copy After:=activeWB.Sheets(activeWB.Sheets.Count)

This extra code does not work in this instance for a reason which is not clear to me.

Hope this helps to clear things up.
Thanks for your interest & assistance.

Regards Mark

(I should also say the typos I made while copying & pasting the code in my original post are not in the macro.)

 

[Deepak]

Loop it...

Option Explicit

Sub OpenLatestFile2()
    Dim activeWB As Workbook
    Dim MyPath As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim LatestDate As Variant
    Dim LMD As Variant, oWS As Range
    Dim wb As Workbook
Application.ScreenUpdating = False
    Set activeWB = Application.ActiveWorkbook
        Set oWS = activeWB.Sheets(1).Range("A1") 'Recheck Sheet Name
       
        If Not oWS.Value <> "" Then
            MsgBox "Opps... A1 is blank", vbCritical
        Exit Sub
        End If
       
        MyPath = "C:\Users\Deepak\Desktop\New Folder\" 'Rechek the same
           If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
                MyFile = Dir(MyPath & "ABC*.*")
                    If Len(MyFile) = 0 Then
                        MsgBox "No files were found...", vbExclamation
                    Exit Sub
                    End If
    Do While Len(MyFile) > 0
        LMD = FileDateTime(MyPath & MyFile)
            If LMD > LatestDate Then
                LatestFile = MyFile
                LatestDate = LMD
            End If
        MyFile = Dir
    Loop
    Workbooks.Open MyPath & LatestFile
    Set wb = ActiveSheet.Parent
    wb.Worksheets(oWS.Value).Copy After:=activeWB.Sheets(activeWB.Sheets.Count)
    wb.Close False
Application.ScreenUpdating = True
End Sub

 

[Emeng]

Hi dEEPAK

You champion! Thanks so much. You have saved me a lot of time & made my work that little bit more productive.

Regards

Mark

 

[Deepak]

Welcome!!