Copy range of cells from master workbook onto multiple files based on criteria-CodePudding

My goal is to copy and paste a range of cells from a master worksheet from the master workbook and populate those cells to a fixed range across multiple workbooks (with the same worksheet) in the Test folder (same template).

The master workbook has a named range which lists all the workbooks that need to be updated. This master workbook also has a range of cells that pulls the data that I want to be copied into the individual workbooks. The data is pulled by using a lookup function. I want to loop through this list and match the names from this list with the workbooks found in the Test folder. If there is a match, then copy the values as a result of the lookup function in the master file to the appropriate workbook.

>         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()
>     
>         Wend
>     
>     End Sub

I can't seem to iterate through the named range and appropriately copy and paste the lookup values between workbooks. I'm not sure how to make my loops work. How do I make this code to work?

REVISION 1:

Sub CopyandPasteData()

DataDir = "C:\My Documents\Test\"
ChDir (DataDir)
Nextfile = Dir("*.xlsm")
Set MasterWB = ActiveWorkbook
MasterWB.Activate

While Nextfile <> ""

    Dim rngCell As Range
    Dim rngList As Range
    Set rngList = MasterWB.Sheets("Master").Range("B9:B111")

    Workbooks.Open (Nextfile)
    Workbooks(Nextfile).Sheets("Report1").Unprotect Password:="qwedsa"

    With MasterWB.Sheets("Master")

        For Each rngCell In rngList

            If rngCell = Nextfile Then
                rngCell.Value = MasterWB("B4").Value
                newvalue = MasterWB.Sheets("Master").Range("L4:U4").Value
                Workbooks(Nextfile).Sheets("Report1").Range("H10:R10") = newvalue

            End If

        Next rngCell

    End With

    Workbooks(Nextfile).Protect Password:="qwedsa"
    Workbooks(Nextfile).Save
    Workbooks(Nextfile).Close
    Nextfile = Dir()
Wend

End Sub

CodePudding user response：

Instead of opening every file and then checking to see if it's in your list, you can loop over the list and check to see if there's a matching file, and only then open and update it.

Sub CopyandPasteData()
    
    Const PW As String = "qwedsa" 'use constants for fixed values
    Dim fldr As String, wbMaster As Workbook, wsMaster As Worksheet
    Dim c As Range, wb As Workbook

    fldr = "C:\My Documents\Test\"
    
    Set wbMaster = ActiveWorkbook
    Set wsMaster = wbMaster.Worksheets("Master")
    
    For Each c In wsMaster.Range("B9:B111").Cells
        If Len(Dir(fldr & c.Value)) > 0 Then          'file exists?
            Set wb = Workbooks.Open(fldr & c.Value)
            With wb.Sheets("Report1")
                .Unprotect Password:=PW    'unprotect sheet and copy data
                .Range("H10:R10").Value = wsMaster.Range("L4:U4").Value
                .Protect Password:=PW
            End With
            wb.Close savechanges:=True
            ' ### fix the line below to reference the correct range ###
            c.Value = wbMaster.Worksheets("sheetName").Range("B4").Value
        End If
    Next c

End Sub