How to copy and paste chosen columns based on two criteria

Requirement:

The user has a "table" with basketball games and referees. in columns 9 and 10 the referees are listed.

The user wants to search the two columns 9 and 10, row by row for a name. If the name is found in a row then copy chosen cells and paste them on sheet2.

This is the code:

Code:

'dim
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lR As Long, eR As Long, i As Integer  ' lR=last row eR=first empty row
Dim name As String 'name=referee
'set
Set ws1 = Sheet1
Set ws2 = Sheet2
lR = ws1.Cells(Rows.Count, 1).End(xlUp).Row
eR = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
name = ws1.Range("M1").Value
For i = 2 To lR
If ws1.Cells(i, "I").Value = name Or ws1.Cells(i, "J").Value = name Then
   ws1.Cells(i, 1).Copy
   ws1.Paste Destination:=ws2.Cells(eR, 3)
   ws1.Cells(i, 6).Copy
   ws1.Paste Destination:=ws2.Cells(eR, 1)
   ws1.Cells(i, 7).Copy
   ws1.Paste Destination:=ws2.Cells(eR, 2)
   ws1.Cells(i, 8).Copy
   ws1.Paste Destination:=ws2.Cells(eR, 4)
   ws1.Cells(i, 9).Copy
   ws1.Paste Destination:=ws2.Cells(eR, 5)
   ws1.Cells(i, 10).Copy
   ws1.Paste Destination:=ws2.Cells(eR, 6)
   
    
End If


Next i
ws2.Columns.AutoFit
ws2.Select

It only finds 1 of 3 entries in column 9, and find 0 of 4 entries in column 10.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/148699-copy-and-paste-chosen-columns-based-on-two-criteria

Solution:

Code:

Option Explicit

Sub FindRef()
    Dim s As Worksheet, t As Worksheet
    Set s = Sheets("Våren -17")
    Set t = Sheets("Sheet1")
    'Dim c As Range, rng As Range
    Dim lr As Long, lr2 As Long, i As Long
    lr = s.Range("I" & Rows.Count).End(xlUp).Row
    'Set rng = s.Range("I2:J" & lr)
    Dim Ref As String
    Ref = s.Range("M1")
    Application.ScreenUpdating = False
    For i = 2 To lr
        lr2 = t.Range("A" & Rows.Count).End(xlUp).Row + 1
        If s.Range("I" & i) = Ref Or s.Range("J" & i) = Ref Then
        s.Range("F" & i & ":G" & i).Copy t.Range("A" & lr2)
        Application.Union(s.Range("A" & i), s.Range("H" & i & ":J" & i)).Copy t.Range("C" & lr2)
        End If
    Next i
    Application.CutCopyMode = True
    Application.ScreenUpdating = True
    MsgBox "complete"
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by AlanSidman.