VBA code to browse for a file, Open it as a macro-free file, copy its contents and paste into the active sheet

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
2,169
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I want a code that will browse for a file using a dialogue box.

After that I want to open the file. I do not want macros in this file to run (only if that's possible).

I run some codes when the workbook opens and I want to avoid that when I am opening it through this approach - that's triggering the open event from another workbook or using a code to open it. I was thinking of setting some global variables for that but I can't get the right way atm.


If I am able to open the file or workbook without running the scripts as described above, there are Worksheets that I want to match their names in both workbooks.

If they match, then I want to match or compare the contents or headers to see if they match as well.

If they match, then I want to copy from the file that I just opened into the workbook that I ran the code from.

Now let me describe my sheet names:

My sheets have the naming convention like:
PLAN 1
PLAN 2
PLAN 3
CAT 1
CAT 2
OBJ

so if both workbooks have PLAN 1, then I want to check if the contents on B6:AM6 are the same on both sheets.

If they match then I want to copy the data from the just opened workbook ( B7:AM & last used row) and paste into the workbook that I ran the code from.

And I repeat the same logic for all the other sheets;
PLAN 2
PLAN 3
CAT 1
CAT 2
OBJ

Afterwards, I close the workbook that I copied from.

Thanks in advance
Kelly
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Upvote 0
I finally resolved this issue:
Code:
Sub Get_Data_From_File_3()
    Dim secAutomation As MsoAutomationSecurity
    Dim FileToOpen, openloop As Boolean, OpenBook As Workbook, copyIt As Boolean
    Dim sh As Worksheet, lr&, rng As Range, sHead As Range, dHead As Range, i&
    openloop = True
    With Application
        .ScreenUpdating = False
        secAutomation = .AutomationSecurity
        .AutomationSecurity = msoAutomationSecurityForceDisable
        While openloop
            FileToOpen = .GetOpenFilename(Title:="Browse for the file", FileFilter:="Excel Files (*.xls*),*xls*")
            If FileToOpen <> False Then
                If Dir(FileToOpen) <> ThisWorkbook.Name Then
                    openloop = False
                    Set OpenBook = .Workbooks.Open(FileToOpen)
                    With OpenBook
                        For Each sh In .Worksheets
                            i = 0
                            lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
                            If lr > 6 Then
                                copyIt = True
                                Set dHead = ThisWorkbook.Sheets(sh.Name).Range("B6")
                                For Each sHead In sh.Range("B6:M6")
                                    If dHead.Offset(, i) <> sHead Then
                                        copyIt = False
                                        Exit For
                                    End If
                                    i = i + 1
                                Next sHead
                                
                                If copyIt Then
                                    Set rng = sh.Range("B7:M" & lr)
                                    ThisWorkbook.Sheets(sh.Name).Range("B7").Resize(rng.Rows.Count, rng.Columns.Count) = rng.Value
                                End If
                            End If
                        Next sh
                    End With
                    OpenBook.Close False
                Else
                    MsgBox "A workbook with same name is opened - rename the source file and try again"
                End If
            Else
                If MsgBox("Do you want to cancel process?", vbYesNo + vbDefaultButton2 + vbExclamation, "File selection cancelled") = vbYes Then
                    openloop = False
                End If
            End If
        Wend
        .AutomationSecurity = secAutomation
        .ScreenUpdating = True
    End With
End Sub

By modifying a script found at:

Code:
Option Explicit

Sub Get_Data_From_File()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A1:E20").Copy
        ThisWorkbook.Worksheets("SelectFile").Range("A10").PasteSpecial xlPasteValues
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
End Sub

with the help some members at www.excelforum.com such as Artik and cubangt.

I appreciate the help.

Have a wonderful time.
Kelly
 
Upvote 0
Solution

Forum statistics

Threads
1,213,531
Messages
6,114,172
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top