VBA Runtime Error 424 (Object Required) / Match cells between sheets - vba

Question

I have a main sheet with an x number of columns. I'm trying to find a match between the first cell in each column and another cell in a number of worksheets. Once the match is found, I'm trying to copy the entire column (excluding the matched value) and paste it onto the worksheet where the worksheet was found. I keep getting a Runtime error 424. The code I wrote is the following
Dim lc As Long
Dim cell1 As Range, cell2 As Range
Dim wbk As Workbook
Dim sh4 As Worksheet
Dim v As Long
Set wbk = ThisWorkbook
Set sh4 = Sheets(4)
lc = sh4.Cells(1, Columns.Count).End(xlToLeft).Column
For v = 1 To lc
Set cell1 = sh4.Cells(1, v)
For Each Sheet In wbk.Worksheets
If Sheet.Index > 5 Then
Sheet.Select
Set cell2 = Range("B1")
If StrComp(CStr(cell1.Value), CStr(cell2.Value), vbBinaryCompare) = 0 Then
If cell1.Offset(0, 0).Value = cell2.Offset(0, 0).Value Then
sh1.Range(Cells(2, v), Cells(28, v)).Resize(1, 2).Copy
Sheet.Range("F2").PasteSpecial xlPasteValues
End If
End If
End If
Next Sheet
Set cell1 = Nothing
Set cell2 = Nothing
Next v
I feel like it's something simple that Im missing. Help would be appreciated. Thank you.

Answer 1

A lot of things seemed wrong with your code. I went ahead and added some quick fixes to hopefully make it run fine. I, personally, HATE the Excel .Paste and .PasteSpecial functions (the hatred is mutual) so I always end up creating lists or using variables to copy stuff around.
Unfortunately I don't think the .Resize function does what you expect it to. By using it the way you do, you're only grabbing the first row and first two columns starting from the first cell of the range your resizing from.
Here's some code that should do the exact same thing as your code, minus the error messages! If you need some help understanding some of the changes I made or how to achieve your goals, don't hesitate to ask!
Dim lc As Long
Dim cell1 As Range, cell2 As Range
Dim wbk As Workbook
Dim sh4 As Worksheet, sh as Worksheet
Dim v As Long
Dim value1 As Variant, value2 As Variant
Set wbk = ThisWorkbook
Set sh4 = wbk.Sheets(4)
lc = sh4.Cells(1, Columns.Count).End(xlToLeft).Column
For v = 1 To lc
Set cell1 = sh4.Cells(1, v)
value1 = cell1.Value
For Each sh In wbk.Worksheets
If sh.Index > 5 Then
sh.Select
Set cell2 = sh.Range("B1")
If StrComp(CStr(value1), CStr(value2), vbBinaryCompare) = 0 Then
If value1 = value2 Then
sh.Range("F2") = sh4.Cells(2, v)
sh.Range("G2") = sh4.Cells(2, v + 1)
End If
End If
End If
Next sh
Set cell1 = Nothing
Set cell2 = Nothing
Next v