'macro Find same cell in two workbooks and copy other cell behind found cell

I have one masterfile and one folder with many documents. In the masterfile there is a list of names. In the other documents there are also names and numbers behind the names (Cell E10:F29). I want to open each the file in the folder and search same names from this document in the masterfile. If the names are identical i want to copy the number behind the document in the cell behind the found cell in the masterfile. It should loop through the document from E10 to E29. If that's done it should close the document and open the next one in the folder.

So fare I can open several documents in the folder and do something with it. Additionally I tried several codes to find identical text. There I have already problems that the code is working. I don't have any code of copying the number behind the found cell.

Any help why find function isn't working or how i could write the copy code?

Dim name_master As Range
Set name_master = Range("D292:D361") ' names in masterfile
Dim firstAddress As String
Dim name_number As Integer
Dim path As String
Dim Filename As String

'open masterfile
    Workbooks.Open Filename:="/Users/masterfile.xlsx"
    Set Samplelist = Workbooks("masterfile.xlsx")
' set paht for folder with several documents
path = "/Users/folder/"
Extension = "*.xlsx" 'format of documents
Dim strFile As String

searchValue = Range("E10")
name_number = 6 ' the copied cell should be paste in column F
r = 292 ' the copied cell should be paste in cell 292
' Loop mache etwas solange es Daten in dem vordefinierten Pfad hat

If path = "" Then
    Exit Sub
    Else
        strFile = Dir(path & Extension)
            Do While Len(strFile) > 0
                Workbooks.Open Filename:=path & strFile  ' open first document in folder
                ' go to first name and search the same name in masterfile
                Workbooks(strFile).Activate
                With Samplelist
                 Set name_master = .Find(searchValue, LookIn:=xlValues)

                 If Not name_master Is Nothing Then
                     ' find same names
                       firstAddress = name_master.Address
                       Do
                            MsgBox "It found identical cell" & Range("E10").Value

                        ' when it is working so fare, hear would be the code for copying number to the correct cell
                        ' search till no match is found
                          Set name_master = .FindNext(name_master)

                        Loop While Not name_master Is Nothing And art_taxon.Address <> firstAddress
                    End If

                End With

       ' close all documents
            Workbooks(strFile).Activate
            Workbooks(strFile).Close
            strFile = Dir() 
            Loop
        End If
End Sub


Solution 1:[1]

Multiple Workbooks Data Transfer

Read Assumnptions and adjust the values in the Constants section.

The Code

Option Explicit
' Assumptions:
' - The file containing this code is one level above the 'Users' Folder.
' - There is maximally one occurrence of a name in the source worksheets.
'   If there is more occurrences, another loop has to be implemented instead
'   of the 'Application.Match' solution.
' - All source worksheets have the same name. If not, worksheet
'   indexes (Variant) can be used instead of the names, e.g. 1 or 2 or 3 etc.,
'   but they have to be the same for all source worksheets.

Sub copyMultiData()

    Const srcPath As String = "Users\folder"      ' Source Path
    Const srcExtension As String = "*.xlsx"       ' Source File Extension
    Const srcName As Variant = "Sheet1"           ' Source Worksheet Name/Index
    Const srcLookUpRange As String = "E10:E29"    ' Source LookUp Range Address
    Const srcValueColumn As Long = 6              ' Source Value Column

    Const tgtPathName As String = "Users\masterfile.xlsx" ' Source File Path
    Const tgtName As Variant = "Sheet1"           ' Target Worksheet Name/Index
    Const tgtLookUpRange As String = "D292:D361"  ' Target LookUp Range Address
    Const tgtValueColumn As Long = 6              ' Target Value Column

    Dim srcWB As Workbook     ' Source Workbook
    Dim srcWS As Worksheet    ' Source Worksheet
    Dim srcLookUp As Variant  ' Source LookUp Array
    Dim srcValue As Variant   ' Source Value Array
    Dim srcFile As String     ' Current Source File Name

    Dim tgtWB As Workbook     ' Target Workbook
    Dim tgtWS As Worksheet    ' Target Worksheet
    Dim tgtLookup As Variant  ' Target LookUp Array
    Dim tgtValue() As Double  ' Target Value Array
    Dim tgtUB As Long         ' Target Number of Elements (Rows)
    Dim tgtCounter As Long    ' Target Arrays Elements (Rows) Counter

    ' Copy values from Target LookUp Range to Target LookUp Array.
    Set tgtWB = Workbooks.Open(Filename:=ThisWorkbook.path _
      & Application.PathSeparator & tgtPathName)      ' Define workbook.
    Set tgtWS = tgtWB.Worksheets(tgtName)             ' Define worksheet.
    tgtLookup = tgtWS.Range(tgtLookUpRange)           ' Copy range to array.

    ' Define Target Number of Elements (rows) of both Target Arrays.
    tgtUB = UBound(tgtLookup)
    ' Initialize and resize Target Value Array to the same size as
    ' Target LookUp Array.
    ReDim tgtValue(1 To tgtUB, 1 To 1)

    ' Loop through files in Source Path.
    srcFile = Dir(ThisWorkbook.path & Application.PathSeparator & srcPath _
      & Application.PathSeparator & srcExtension)
    Do While Len(srcFile) > 0
        ' Copy values from Source Ranges to Source Arrays.
        Set srcWB = Workbooks.Open(Filename:=ThisWorkbook.path _
          & Application.PathSeparator & srcPath & Application.PathSeparator _
          & srcFile)                                  ' Define workbook.
        Set srcWS = srcWB.Worksheets(srcName)         ' Define worksheet.
        With srcWS.Range(srcLookUpRange)
            srcLookUp = .Value                        ' Copy range to array.
            srcValue = .Offset(, srcValueColumn - .Column).Value ' The same.
        End With
        ' Loop through elements (rows) of Target LookUp Array.
        For tgtCounter = 1 To tgtUB
            ' Try to find a match in Source LookUp Array.
            If Not IsError( _
              Application.Match(tgtLookup(tgtCounter, 1), srcLookUp, 0)) Then
                ' Add value (sum) of found element in Source Value Array
                ' to previous value of current element in Target Value Array.
                tgtValue(tgtCounter, 1) = tgtValue(tgtCounter, 1) + srcValue( _
                  Application.Match(tgtLookup(tgtCounter, 1), srcLookUp, 0), 1)
            Else ' No match (not found).
            End If
        Next tgtCounter
        srcWB.Close False ' 'False' means do not save changes.
        srcFile = Dir()
    Loop

    ' Copy values of Target Value Array to Target Value Range.
    With tgtWS.Range(tgtLookUpRange)
        ' Possible previous values will be overwritten (no need to clear).
        .Offset(, tgtValueColumn - .Column).Value = tgtValue
    End With

    ' Choose either:
    'tgtWB.Close True ' Save & Close ('True' means save changes).
    ' or one of the following:
    'tgtWB.Save       ' Save
    'tgtWB.Close      ' Close

    MsgBox "Master Workbook successfully updated.", vbInformation

End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 VBasic2008