Macro: Open .xlsx in folder

[StudentofExcel]

Hello all,

I have searched around the web but I didn't find answer to this "problem".

What I would like is Macro that would open .xlsx file that is located in the same folder as Excel with Macro (only these two files would be in this folder.), but without specifying path location of both files because it will be moved around by other people.(Excel with Macro name can be name specific but .xlsx would not be named same every time) Folder name can be fixed if that makes it easier.

Goal is to open .xlsx file and move tab "Sheet1" to Excel with Macro.

If someone could help that would be great.

Thanks

 

[Yongle]

Try this
- first found "other file" opened
- first sheet copied as first sheet in macro file
- "other file" closed
- macro file saved

Sub OpenOtherFileAndCopyFirstSheet()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    Dim file As Variant, myFolder As String, wb2 As Workbook, wb1 As Workbook
    Set wb1 = ThisWorkbook
    myFolder = wb1.Path & "\"
    file = Dir(myFolder)
    While (file <> "")
        If file <> wb1.Name Then
            Set wb2 = Workbooks.Open(myFolder & file)
            wb2.Sheets(1).Copy before:=wb1.Sheets(1)
            wb2.Close False
            wb1.Save
            Exit Sub
      End If
        file = Dir
    Wend
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

 

[Yongle]

It would be safer to check that the folder contains exactly 2 files before the macro continues, otherwise
- VBA will fail if only one file in folder
- wrong file may be opened if folder contains more than 2 files

So here is a version that does just that:

Sub OpenOtherFileAndCopyFirstSheet2()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    Dim file As Variant, myFolder As String, wb2 As Workbook, wb1 As Workbook, c As long
    Set wb1 = ThisWorkbook
    myFolder = wb1.Path & "\"
    file = Dir(myFolder)
    While (file <> "")
        c = c + 1
        file = Dir
    Wend
    If c = 2 Then
        file = Dir(myFolder)
        While (file <> "")
            If file <> wb1.Name Then
                Set wb2 = Workbooks.Open(myFolder & file)
                wb2.Sheets(1).Copy before:=wb1.Sheets(1)
                wb2.Close False
                wb1.Save
                [COLOR=#ff0000]GoTo TheEnd[/COLOR]
          End If
            file = Dir
        Wend
    Else
        MsgBox "Proces cancelled" & vbCr & "Folder contains " & c & " files", vbExclamation, "WARNING"
    End If
[COLOR=#ff0000]TheEnd:[/COLOR]
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

Note the amendment in Red - needed also in other version - otherwise recalculation remains set to manual!!

 

[StudentofExcel]

Thank you so much for your help. It works perfectly.