Excel Row paste with VBA - excel

Question

Hi guys i need some help on VBA.
I have range of numbers in sheet 1 from cells A6:O29. Next I have specific numbers selected in Sheet 3 in Column "B".
[![enter image description here][1]][1]
[![enter image description here][2]][2]
I want to loop throw each value in Sheet 3 Column B and find that specific value in Sheet 1 range A6:O29
Next it should paste Entire Row from Sheet 1 starting From Column (Q:CF) in Sheet 3 Starting from Column C onwards
I have coded it but its not working.
Private Sub CommandButton1_Click()
Dim main As Worksheet
Dim outcome As Worksheet
'main sheet contains Range to search number in
Set main = ThisWorkbook.Sheets("Sheet1")
'outcome sheet has specific values in Column B
Set outcome = ThisWorkbook.Sheets("Sheet3")
'column B values are considrered as doubles
Dim valuesfind As Double
'range where values are to be found
Dim myrange As Range
Set myrange = Worksheets("Sheet1").Range("A6:O29")
'no of times to loop code based on values in outcomesheet
locations = Worksheets("Sheet3").Cells(Rows.Count, 2).End(xlUp).Row
For i = 6 To locations
degrees = outcome.Range("B" & i).Value
For b = 6 To Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
If main.Range("A6:O29" & b).Value = degrees Then
outecome.Range("C:BR" & i).Value = main.Range("Q:CF" & b).Value
Exit For
End If
Next b
Next i
End Sub
[1]: https://i.stack.imgur.com/uBo66m.png
[2]: https://i.stack.imgur.com/D0bRUm.png

Answer 1

Please remember to declare all variables, add Option Explicit at the top of your module to help you enforce it.
Try the code below:
Option Explicit
Private Sub CommandButton1_Click()
'main sheet contains Range to search number in
Dim main As Worksheet
Set main = ThisWorkbook.Sheets("Sheet1")
Const mainCopyRng As String = "Q?:CF?"
'outcome sheet has specific values in Column B
Dim outcome As Worksheet
Set outcome = ThisWorkbook.Sheets("Sheet3")
Const outcomePasteRng As String = "C?:BR?"
'range where values are to be found
Dim myrange As Range
Set myrange = main.Range("A6:O29")
'no of times to loop code based on values in outcomesheet
Dim outcomeLastRow As Long
outcomeLastRow = outcome.Cells(Rows.Count, 2).End(xlUp).Row
Dim i As Long
For i = 6 To outcomeLastRow
Dim Degrees As Double
Degrees = outcome.Cells(i, 2).Value
Dim searchRng As Range
Set searchRng = myrange.Find(Degrees, LookIn:=xlValues, LookAt:=xlWhole)
If Not searchRng Is Nothing Then
Dim searchRow As Long
searchRow = searchRng.Row
outcome.Range(Replace(outcomePasteRng, "?", i)).Value = main.Range(Replace(mainCopyRng, "?", searchRow)).Value
End If
Next i
End Sub

Answer 2

This should work.
Sub Test()
Dim main As Worksheet
Set main = ThisWorkbook.Sheets("Sheet1")
Dim myrange As Range
Set myrange = main.Range("A6:O29")
Dim outcome As Worksheet
Set outcome = ThisWorkbook.Sheets("Sheet3")
'Set reference to locations in sheet3.
Dim locations As Range
With outcome
Set locations = .Range(.Cells(1, 2), .Cells(Rows.Count, 2).End(xlUp))
End With
'Search for each location in Sheet1 and if found copy to Sheet3.
Dim location As Range
Dim FoundLocation As Range
For Each location In locations
Set FoundLocation = myrange.Find( _
What:=location, _
After:=myrange.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not FoundLocation Is Nothing Then
main.Cells(FoundLocation.Row, 1).Resize(, 15).Copy _
Destination:=location.Offset(, 1)
End If
Next location
End Sub