Loop issues to find match criteria from master file to copy and paste matching individual files

nobodysfool

New Member
Joined
Dec 21, 2022
Messages
2
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
Platform
  1. Windows
Newbie here. I am still learning the different loops in VBA. When I debug the code, the For Each loop doesn't seem to work at all and I'm not sure how to fix it. I was hoping someone could help me!

I am looking to do the following with this code:
  1. Refer to named range from master worksheet from a master workbook (saved in a different location but is open)
  2. Loop through all the excel enabled macro files from one folder
  3. Match the file name from each of these files with the named range from master workbook
  4. If there is a match, then copy values only from lookup range from the master worksheet and paste values onto the matched file (worksheet called Report1)
    1. All the Report1 worksheets in the individual files are password protected so unprotect, make the changes, protect, save and then close
  5. Repeat this process until the named range list is exhausted

VBA Code:
    Sub CopyPasteData()
    
    Dim DataDir As Object
    Dim Nextfile As Workbook
    Dim MasterWB As Workbook
    Dim fileCell As String
    Dim newValues As Long
    
    DataDir = "C:\My Documents\Test\"
    ChDir (DataDir)
    Nextfile = Dir("*.xlsm")
    Set MasterWB = ActiveWorkbook                                       'master workbook to extract data from

 
    While Nextfile <> ""                                                'iterate through all macro enabled files in the subfolder

        For Each fileCell In MasterWB.Names("nameList").RefersToRange   'loop through all cells in the named range
            If fileCell = Nextfile Then                                 'if cell from named range matches with workbook, then replace over range of cells below

                newValues = MasterWB.Sheets("Master").Range("L4:U4").Value
                Workbooks.Open (Nextfile)
                Workbooks(Nextfile).Sheets("Report1").Unprotect Password:="qwedsa"


                Workbooks(Nextfile).Sheets("Report1").Range("H10:R10") = newValues
                Workbooks(Nextfile).Protect Password:="qwedsa"
                Workbooks(Nextfile).Save
                Workbooks(Nextfile).Close

            End If

        Next fileCell

        Nextfile = Dir()
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
I can't seem to find the edit button but the code is missing 2 lines:

Wend

End Sub
 
Upvote 0

Forum statistics

Threads
1,214,801
Messages
6,121,644
Members
449,045
Latest member
Marcus05

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