Find Differences between columns sheets

I have this script which finds the same text data in one sheet column to another and msgBox the titles that are the same each time.
I want to adapt it to select the data that does not match and paste it into Sheet 1.
Below is the script and attached is the excel file, thanks for any help.
Dale

Sub findDiff()

Dim Name1() As String
Dim Name2() As String
Dim NameNum1 As Long
Dim NameNum2 As Long
Dim NameMatch() As String
Dim i As Long
Dim j As Long
Dim k As Long


Sheets(2).Select

' Get Number of Names
NameNum1 = 2
Do While Not IsEmpty(Cells(NameNum1, 1))
   NameNum1 = NameNum1 + 1
Loop
NameNum1 = NameNum1 - 1

' Define "Names1" array and populate variable
ReDim Name1(2 To NameNum1) As String
For i = 2 To NameNum1
   Name1(i) = Cells(i, 1)
Next i


Sheets(3).Select

' Get Number of Names
NameNum2 = 2
Do While Not IsEmpty(Cells(NameNum2, 1))
   NameNum2 = NameNum2 + 1
Loop
NameNum2 = NameNum2 - 1

' Define "Names2" array and populate variable
ReDim Name2(2 To NameNum2, 1 To 2) As String
For i = 2 To NameNum2
   Name2(i, 1) = Cells(i, 1)
         
Next i

' Define "NameMatch" array
If (NameNum1 > NameNum2) Then
   ReDim NameMatch(2 To NameNum2, 1 To 2) As String
Else
   ReDim NameMatch(2 To NameNum1, 1 To 2) As String
End If

' Populate "NameMatch" variable with any names that match
k = 2
For i = 2 To NameNum1
   For j = 2 To NameNum2
      If (Name1(i) = Name2(j, 1)) Then
         NameMatch(k, 1) = Name2(j, 1)
         
         k = k + 1
      End If
   Next j
Next i


' no match
If (k = 2) Then
  MsgBox ("No names match between workbooks.  Program will end.")
 GoTo 10000
End If

'  match
For i = 2 To (k - 1)

MsgBox (NameMatch(i, 1))


Next i
   
10000 End Sub