Program is only outputting one cell of a row, need to output entire row...

Private Sub Exit_Click()
Me.Hide
End Sub
 
Private Sub Open_Click()
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim strPath As String, strFile1 As String, strFile2 As String
Dim wbkThis As Workbook, wbk1 As Workbook, wbk2 As Workbook
Dim wksDest As Worksheet, wksSource As Worksheet, wksCheck As Worksheet
Dim rngMatch As Range, rngCheck As Range, rngFound As Range, rngCopy As Range
 
  CommonDialog1.flags = cdlOFNExplorer Or cdlOFNLongNames
  CommonDialog1.FileName = ""
  CommonDialog1.Filter = "Excel Files (*.xls)|*.xls|"
  CommonDialog1.DialogTitle = "Browse for file"
  CommonDialog1.ShowOpen
 
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(CommonDialog1.FileName)
 
    Set wbkThis = Workbooks.Add
    Set wbk1 = xlBook
    Set wbk2 = Excel.Workbooks.Open("c:\Users\User1.xls")
   
    'Change sheet names as required
   
    ' This is the sheet to copy to
    Set wksDest = wbkThis.Sheets("Sheet1")
    ' This is the sheet in XLS1
    Set wksSource = wbk1.Sheets(1)
    Set wksCheck = wbk2.Sheets(1)
     
 
    ' Get first blank row in main workbook to copy to
    With wksDest
        Set rngCopy = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
    ' First cell to check in XLS1
    Set rngMatch = wksSource.Range("D1")
    ' Set check range to all used cells in column A of XLS2
    With wksCheck
        Set rngCheck = wksCheck.Range("a2")
        'Set rngCheck = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    ' Loop through cells in column A of XLS1 until a blank cell is encountered
    Do Until Len(rngMatch.value) = 0
        Set rngFound = rngCheck.Find(what:=rngMatch.value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFound Is Nothing Then
            ' Copy data from XLS2 to this workbook
            rngFound.Copy rngCopy
            Set rngCopy = rngCopy.Offset(1, 0)
        End If
        Set rngMatch = rngMatch.Offset(1, 0)
    Loop
    wbk1.Close False
    wbk2.Close False
    wbkThis.Save
End Sub