Copying values based on condition from one sheet to another - excel

Question

I am trying to build a macro that will match the ID between two sheets, then find the value and copy the header from scanned sheet to another.
The end result for SheetOne first couple of rows would be:
ID Month of No Month of Maybe Month of Yes
Row2: 1 January February March
Row3: 2 January March April
It needs to scan through columns (or any other way) at first for value "No", then for value "Maybe", then for value "Yes" and then copy the header of when the value first appeared. I've tried to just copy any value once ID's match, but that didn't work.
Screenshot of SheetOne:
Screenshot of SheetTwo:
I am in the beginning phase. This is my code so far:
Sub movingValues()
'declaring/setting variables
Dim SheetOneWs As Worksheet
Dim SheetTwoWs As Worksheet
Dim SheetOneLastRow As Long
Dim SheetTwoLastRow As Long
Dim SheetOneRng As Range
Dim SheetTwoRng As Range
Set SheetOneWs = ThisWorkbook.Worksheets("SheetOne")
Set SheetTwoWs = ThisWorkbook.Worksheets("SheetTwo")
SheetOneLastRow = SheetOneWs.Range("A" & Rows.Count).End(xlUp).Row
SheetTwoLastRow = SheetTwoWs.Range("A" & Rows.Count).End(xlUp).Row
Set SheetOneRng = SheetOneWs.Range("A2:D13" & SheetOneLastRow)
Set SheetTwoRng = SheetTwoWs.Range("A2:M13" & SheetTwoLastRow)
'work process
For i = 2 To SheetOneLastRow
If SheetOneWs.Range(i, 1).Value = SheetTwoWs.Range(i, 1).Value Then
SheetTwoWs.Cells(i, 2).Copy
SheetOneWs.Activate
SheetOneWs.Cells(i, 2).Select
ActiveSheet.Paste
SheetTwoWs.Activate
End If
Next i
End Sub

Answer 1

ORIGINAL CODE
This should work:
Sub movingValues()
'declaring/setting variables
Dim SheetOneWs As Worksheet, SheetTwoWs As Worksheet
Dim SheetOneLastRow As Long, SheetTwoLastRow As Long
Dim SheetOneRng As Range, SheetTwoRng As Range
Dim cell As Range, i As Integer
Application.Calculation = xlCalculationManual
Set SheetOneWs = ThisWorkbook.Worksheets("SheetOne")
Set SheetTwoWs = ThisWorkbook.Worksheets("SheetTwo")
SheetOneLastRow = SheetOneWs.Range("A" & Rows.Count).End(xlUp).Row
SheetTwoLastRow = SheetTwoWs.Range("A" & Rows.Count).End(xlUp).Row
Set SheetOneRng = SheetOneWs.Range("A2:D13" & SheetOneLastRow)
Set SheetTwoRng = SheetTwoWs.Range("A2:M13" & SheetTwoLastRow)
SheetOneWs.Range("B2:D13").Value = ""
For i = 2 To SheetTwoLastRow
'For Each cell In SheetTwoWs.Range(Cells(i, "B"), Cells(i, "M"))
For Each cell In SheetTwoWs.Range("B" & i & ":" & "M" & i)
If cell.Value = "No" Then
SheetOneWs.Cells(cell.Row, "B").Value = SheetTwoWs.Cells(1, cell.Column)
Exit For
End If
SheetOneWs.Cells(cell.Row, "B").Value = "No data"
Next cell
For Each cell In SheetTwoWs.Range("B" & i & ":" & "M" & i)
If cell.Value = "Maybe" Then
SheetOneWs.Cells(cell.Row, "C").Value = SheetTwoWs.Cells(1, cell.Column)
Exit For
End If
SheetOneWs.Cells(cell.Row, "C").Value = "No data"
Next cell
For Each cell In SheetTwoWs.Range("B" & i & ":" & "M" & i)
If cell.Value = "Yes" Then
SheetOneWs.Cells(cell.Row, "D").Value = SheetTwoWs.Cells(1, cell.Column)
Exit For
End If
SheetOneWs.Cells(cell.Row, "D").Value = "No data"
Next cell
Next i
Application.Calculation = xlCalculationManual
End Sub
I am working on cutting down the code into a single for loop so I'll update soon with better code, but the above code does the trick.
UPDATED CODE
I define a second Sub which checks the "No"s, "Maybe"s and "Yes"s, and this sub is called 3 times in the For loop.
Option Explicit
Dim SheetOneWs As Worksheet, SheetTwoWs As Worksheet
Sub movingValues()
'declaring/setting variables
Dim SheetOneLastRow As Long, SheetTwoLastRow As Long
Dim SheetOneRng As Range, SheetTwoRng As Range
Dim cell As Range, i As Integer
Set SheetOneWs = ThisWorkbook.Worksheets("SheetOne")
Set SheetTwoWs = ThisWorkbook.Worksheets("SheetTwo")
Application.Calculation = xlCalculationManual
SheetOneLastRow = SheetOneWs.Range("A" & Rows.Count).End(xlUp).Row
SheetTwoLastRow = SheetTwoWs.Range("A" & Rows.Count).End(xlUp).Row
Set SheetOneRng = SheetOneWs.Range("A2:D13" & SheetOneLastRow)
Set SheetTwoRng = SheetTwoWs.Range("A2:M13" & SheetTwoLastRow)
SheetOneWs.Range("B2:D13").Value = ""
For i = 2 To SheetTwoLastRow
'For Each cell In SheetTwoWs.Range(Cells(i, "B"), Cells(i, "M"))
CheckValue "No", "B", i
CheckValue "Maybe", "C", i
CheckValue "Yes", "D", i
Next i
Application.Calculation = xlCalculationManual
End Sub
Sub CheckValue(checkString As String, colNum As String, i As Integer)
Dim cell As Range
For Each cell In SheetTwoWs.Range("B" & i & ":" & "M" & i)
If cell.Value = checkString Then
SheetOneWs.Cells(cell.Row, colNum).Value = SheetTwoWs.Cells(1, cell.Column)
Exit For
End If
SheetOneWs.Cells(cell.Row, colNum).Value = "No data"
Next cell
End Sub
Some of your variables (SheetOneRng) are no longer required.