Macro for last post
Code:
Sub CopyPaste20Q2() ' Question 2 https://excelfox.com/forum/showthread.php/2494-Copy-and-paste-of-data-if-matches
' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13388&viewfull=1#post13388
Rem 1 Worksheets info
' 2.xlsx
Dim Wb2 As Workbook
Set Wb2 = Workbooks("2.xlsx")
Dim Ws1 As Worksheet: Set Ws1 = Wb2.Worksheets.Item(1)
Dim Lr1 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Dim arrA() As Variant: Let arrA() = Ws1.Range("A1:A" & Lr1 & "").Value2 ' 2.xlsx sheet1 column A
' Dim Ws2 As Worksheet: Set Ws2 = Wb2.Worksheets.Item(2)
' Dim Rng22 As Range: Set Rng22 = Ws2.Range("A1").CurrentRegion ' Row to be copied - (only first row)entire row of data from sheet2 of 2.xlsx
' Actual File.xlsx
Dim Wb As Workbook, Ws As Worksheet
Set Wb = Workbooks("Actual File.xlsx")
Set Ws = Wb.Worksheets.Item(1)
Dim Jmax As Long: Let Jmax = Ws.Range("J" & Ws.Rows.Count & "").End(xlUp).Row
Dim arrB() As Variant: Let arrB() = Ws.Range("B1:B" & Jmax & "").Value2 ' Actual File.xlsx sheet1 column B
Rem 2 do it
Dim Cnt ' this is for - going down column A of 2.xlsx sheet1 looking for a match in Actual File.xlsx sheet1 column B
For Cnt = 2 To Jmax
Dim MtchRes As Variant
Let MtchRes = Application.Match(arrA(Cnt, 1), arrB(), 0) ' - going down column A of 2.xlsx sheet1 looking for a match in Actual File.xlsx sheet1 column B
If IsError(MtchRes) Then
' no match do nothing
Else ' Cnt is now at the row number of where 2.xlsx sheet1 column A was found in Actual File.xlsx sheet1 column B
Dim Lc1Cnt As Long: Let Lc1Cnt = Ws1.Cells.Item(Cnt, Ws1.Columns.Count).End(xlToLeft).Column
' Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").ClearContents ' clear row Cnt of all data before pasting
' Rng22.Copy Destination:=Ws1.Range("B" & Cnt & "") ' copy the (only first row)entire row of data from sheet2 of 2.xlsx and paste it to the row in sheet 1 of 2.xlsx at the row number of the matched value of 2.xlsx sheet1
Let Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").Value = Ws1.Evaluate("=2*" & Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").Address & "") ' then double the value of that row of 2.xlsx
End If
Next Cnt
End Sub
Bookmarks