Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Macro code for import data from Excel 2 files password protected

0

Hello everyone.

I'm trying to create a macro that doesn't work the way I want it to.

I have 2 Excel files, one old and one new. I've created a macro button in the new file that should only import some data from the old one, cell A1 and cells B2: D5. I failed to convince him to work properly. The code copies all the data.

The second problem is that both files are password protected against modification of some cells (yellow cells). The password is "secret". If I leave the password, the macro code does not copy anything. I tried to enter the password in the OpenFile command, but I was definitely doing something wrong.

I just need some hint for this code, as I am pretty new in the VBA world. Thanks in advance.

Below is the code I use.

Sub ImportData()
    Dim fileToOpen As Variant
    Dim fileFilterPattern As String
    Dim NewWorksheet As Worksheet
    Dim OldWorkbook As Workbook
    Application.ScreenUpdating = False
    fileFilterPattern = "Excel Files (*.xls; *.xlsx),*.xls;*.xlsx"
    fileToOpen = Application.GetOpenFilename(fileFilterPattern)
If fileToOpen = False Then
        MsgBox "No file selected."
    Else
    Workbooks.Open (fileToOpen)
        Set OldWorkbook = ActiveWorkbook
        Set NewWorksheet = ThisWorkbook.Worksheets("Data")
        OldWorkbook.Worksheets(2).Range("A1:A1").CurrentRegion.Copy NewWorksheet.Range("A1:A1")
        OldWorkbook.Close False
End If
        Application.ScreenUpdating = True
End Sub
 
excel
MS Office Version: 2016
posted by: stef_ionesco (rep: 2) on Fri Jun 3, 2022 at 2:07 am
Answer
Discuss

Discussion

The things is that all the cells I want to copy are not password protected. The password is only for the other cells and should not need the password for copy them. And
 
OldWorkbook.Worksheets(2).Range("A1:A1").CurrentRegion.Copy NewWorksheet.Range("A1:A1")

it's not copying only the A1 cell, but is copying all the cells. It should be something like this:

OldWorkbook.Worksheets(2).Range("A1:A1").CurrentRegion.Copy NewWorksheet.Range("A1:A1")

OldWorkbook.Worksheets(2).Range("B2:D5").CurrentRegion.Copy NewWorksheet.Range("B2:D5")
stef_ionesco (rep: 2) Jun 3, '22 at 1:31 pm
Stef

You should put this point in the Discussion below my answer really but... 

Did you try my revised workbook? It'swuth my Answer (if you're ligged on), it works and it copies the data (and not just cell A1 - the  .CurrentRegion extends it to where Excel finds a blank row and column).

You used the Copy method which requires unprotected sheets (even though you're not copying protected cells) I believe. Once unprotected, you can use your second Copy statement (specifying B2:D5) or the first -  depends on what you want to do. 

Hope this makes sense.
John_Ru (rep: 6142) Jun 3, '22 at 2:01 pm
Add to Discussion

Answers

0
Selected Answer

Hi Stef and welcome to the Forum

Both your. xlsm and xlsx files have password protection so you need to use the Worksheet.Unprotect method to provide the password to unlock them BEFORE the copy line. That's done in the attached revised .xlsm file (and with changes and instructive comments in bold below). Once the copy has succeeded, the Worksheet.Protect method reapplies the password protection:

Sub ImportData()

    Dim fileToOpen As Variant
    Dim fileFilterPattern As String
    Dim NewWorksheet As Worksheet
    Dim OldWorkbook As Workbook

    Application.ScreenUpdating = False

    fileFilterPattern = "Excel Files (*.xls; *.xlsx),*.xls;*.xlsx"

    fileToOpen = Application.GetOpenFilename(fileFilterPattern)

If fileToOpen = False Then
        MsgBox "No file selected."
    Else

    Workbooks.Open (fileToOpen)

        Set OldWorkbook = ActiveWorkbook

        Set NewWorksheet = ThisWorkbook.Worksheets("Data")
        'remove protection on both source and destination sheets
        OldWorkbook.Worksheets(2).Unprotect "secret"
        NewWorksheet.Unprotect "secret"
        ' copy to unprotected sheet
        OldWorkbook.Worksheets(2).Range("A1:A1").CurrentRegion.Copy NewWorksheet.Range("A1:A1")
        ' close without saving (so no need to re-protect)
        OldWorkbook.Close False
        'reapply protection to destination sheet
        NewWorksheet.Protect "secret"

End If

    Application.ScreenUpdating = True

End Sub

Hope this fixes your problem. If so, please remember to mark this Answer as "Selected".

posted by: John_Ru (rep: 6142) on Fri Jun 3, 2022 at 8:58 am
Discuss

Discussion

I found the error... As you say... CurrentRegion copies all the data, until Excel find an empty row or column. So, I delete CurrentRegion.
I don't know why, but for me CurrentRegion sounds like something limited. Anyway... My new code is:

  
Sub ImportData()
    Dim fileToOpen As Variant
    Dim fileFilterPattern As String
    Dim NewWorksheet As Worksheet
    Dim OldWorkbook As Workbook
    Application.ScreenUpdating = False
    fileFilterPattern = "Excel Files (*.xls; *.xlsx),*.xls;*.xlsx"
    fileToOpen = Application.GetOpenFilename(fileFilterPattern)
If fileToOpen = False Then
        MsgBox "No file selected."
    Else
    Workbooks.Open (fileToOpen)
        Set OldWorkbook = ActiveWorkbook
        Set NewWorksheet = ThisWorkbook.Worksheets("Data")
        OldWorkbook.Worksheets(2).Range("A1").Copy NewWorksheet.Range("A1")
        OldWorkbook.Worksheets(2).Range("B2:D5").Copy NewWorksheet.Range("B2:D5")
        OldWorkbook.Close False
End If
    Application.ScreenUpdating = True
End Sub
 
And now work like a charm.
stef_ionesco (rep: 2) Jun 4, '22 at 1:50 am
Stef. Glad you fixed it. CurrentRegion can be very useful on occssions (when you don't know the extent of data, only that it stops) as can UsedRange and the range combination functions Union and Intersect in VBA- look them up if you get chance. 
John_Ru (rep: 6142) Jun 4, '22 at 2:07 am
Thanks for selecting my answer, Stef. 
John_Ru (rep: 6142) Jun 4, '22 at 3:12 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login