Dear Friends,
This seems to be very simple question but could not find any solution in other forums.
Assume I have 1st WB with all data stored in sheet1 from A to H columns.
Now lets say 2nd WB in sheet1 with only column A data.
In 1st WB column E has values (not in order) incl duplicates and blanks few of them matching with column A in 2nd WB.
Now my VB code should help me for each matching value starting from A1 in 2nd WB with E:E in 1st WB, it should copy the values of 3 adjacent columns (leaving one) to the left and paste it after the matched value in 2nd WB in Col B, C & D.
Eg: If 2nd WB A1 matches with 1st WB E40 value then C40, B40 & A40 has to be copied to B1, C1 & D1 in 2nd WB. This should continue until the last value in the col A of 2nd WB.
My code works 99% but instead copies F40, G40 & H40 to target columns. Below is my code but I was experimenting with some other similar test data having in the same workbook but different worksheets.
Sub MatchAndCopy()
Dim k As Long, n As Variant, rSource As Range, rMatch As Range, rng As Range
Dim s As String, t As String
Application.ScreenUpdating = False
s = InputBox("Please enter the File Name")
t = InputBox("Please enter the Start Range")
With Workbooks(s).Sheets("Sheet1")
Set rSource = .Range(t, .Range(t).End(xlDown))
End With
With Workbooks(s).Sheets("Sheet2")
Set rMatch = .Range("A2", .Range("A2").End(xlDown))
End With
For Each rng In rMatch
'rng.Interior.ColorIndex = 0
n = Application.Match(rng.Value, rSource, 0)
If IsNumeric(n) Then
With rng.Resize(, 3)
.Value = rSource.Rows(n).Resize(, 3).Value
End With
Else
End If
Next rng
Application.CutCopyMode = False
Application.ScreenUpdating = True
Windows(s).Activate
End Sub
Display More
Note: Vlookup might not work here because there is huge lot of filtered data which cannot work in this case.
My example file for reference and please suggest the right code...