Help in VBA to transfer data into multiple files in a folder

[Kartyk]

The below data updates other sheets within a file using the first columns as key. I would need to replicate the same logic whereby updating different files in a folder. Files can have a sheet name pre-
defined.

Help would be greatly appreciated.

Sub UpdateData()


Dim xRow As Long, yCol As Long, k As Long, intPos As Long
Dim ws As Worksheet, wsMaster As Worksheet
Dim dataCompare As String, destCompare As String
Dim destRange As Range, copyRange As Range


On Error Resume Next
Application.ScreenUpdating = False
Set wsMaster = Worksheets("Mastersheet")
wsMaster.Select
xRow = Cells(Rows.Count, "A").End(xlUp).Row
yCol = Cells(1, Columns.Count).End(xlToLeft).Column
For k = 2 To xRow
wsMaster.Select
dataCompare = Trim(CStr(Range("A" & k)))
For Each ws In Worksheets
intPos = 0
If ws.Name <> "master" Then
ws.Select
Set destRange = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
intPos = Application.WorksheetFunction.Match(dataCompare, destRange, 0)
If intPos > 0 Then
Application.CutCopyMode = False
wsMaster.Select
Set copyRange = Range(Cells(k, 1), Cells(k, yCol))
copyRange.Copy
ws.Select
Range("A" & intPos + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If
Next
Next
Application.ScreenUpdating = True
End Sub

Cheers

[mana]

Option Explicit

Sub test()
    Dim myFld As String
    Dim myName As String
    Dim myBook As Workbook
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then Exit Sub
        myFld = .SelectedItems(1) & "\"
    End With
      
    myName = Dir(myFld & "*.xls")
    
    Do While myName <> ""
        Set myBook = Workbooks.Open(Filename:=myFld & myName)
        Call UpdateData(myBook)
        myBook.Close True
        
        myName = Dir()
    Loop
    
End Sub


Private Sub UpdateData(wb As workbook)
    '
end sub

[Kartyk]

Hi Mana, thank you. Could you please help me integrate the code and also, I do not want folder picker. I woul define a path and it stays constant.

Cheers

[mana]

Option Explicit

Sub test()
    Dim myFld As String
    Dim myName As String
    Dim myBook As Workbook
    
    myFld = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\test\"
      
    myName = Dir(myFld & "*.xls")
    
    Do While myName <> ""
        Set myBook = Workbooks.Open(Filename:=myFld & myName)
        Call UpdateData(myBook)
        myBook.Close True
        
        myName = Dir()
    Loop
    
End Sub


Private Sub UpdateData(wb As Workbook)
    Dim xRow As Long, yCol As Long, k As Long, intPos As Variant
    Dim ws As Worksheet, wsMaster As Worksheet
    Dim dataCompare As String, destCompare As String
    Dim destRange As Range, copyRange As Range


    Application.ScreenUpdating = False
    
    Set wsMaster = wb.Worksheets("Mastersheet")
    
    With wsMaster
        xRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        yCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
        For k = 2 To xRow
            dataCompare = Trim(CStr(.Range("A" & k)))
            For Each ws In wb.Worksheets
                If ws.Name <> "master" Then
                    Set destRange = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
                    intPos = Application.Match(dataCompare, destRange, 0)
                    If IsNumeric(intPos) Then
                        ws.Range("A" & intPos + 1).Resize(, yCol).Value = _
                            .Range("A" & k).Resize(, yCol).Value
                    End If
                End If
            Next
        Next
    End With
    
    Application.ScreenUpdating = True
    
End Sub

[mana]

worksheet name should be corrected


> Set wsMaster = wb.Worksheets("Mastersheet")
> If ws.Name <> "master" Then

[Kartyk]

Yes, thanks a lot.