Kartyk
09-18-2016, 01:43 AM
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
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