PDA

View Full Version : Check each cell to see if they match then copy to certain cell



JoeDogs
07-18-2017, 11:21 AM
I have 2 sets of data that correspond with eachother.
Id like a vba that checks a cell in B6 in sheet 1 and then checks every cell in column A1 in sheet 1. If there is a match, I want it to copy and paste the row in sheet 2 to a particular cell in sheet 1.

I am very new to vba and have the following code which doesnt seem to be working..

Sub test()
Application.ScreenUpdating = False
Dim sBook_t As String
Dim sBook_s As String

Dim sSheet_t As String
Dim sSheet_s As String
Dim SSheet_n As String

Dim i As Integer
Dim p As Integer
Dim s As Integer

sSheet_t = "Sheet1"
sSheet_s = "Sheet2"

'row 6 is where the data starts
i = 6
p = 6
For s = 1 To 2000
If Sheets(sSheet_s).Cells(i, 1).Value = Sheets(sSheet_t).Cells(p, 2).Value Then
Range(Sheets(sSheet_t).Cells(p, 1), Sheets(sSheet_t).Cells(p, 14)).Copy
Sheets(sSheet_s).Cells(i, 26).PasteSpecial xlPasteValues
i = i + 1
Else:
p = p + 1

End If
Next
End Sub

mana
07-19-2017, 05:16 AM
Option Explicit


Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim c As Range
Dim m

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

For Each c In ws1.Range("b6", ws1.Range("b" & Rows.Count).End(xlUp))
m = Application.Match(c, ws2.Columns("a"), 0)
If IsNumeric(m) Then
c.Offset(, 24).Resize(, 14).Value = ws2.Rows(m).Resize(, 14).Value
End If
Next

End Sub