Compare Sheet1 and Sheet2 for every match and then write them on Sheet3
Shouldn't this:

For k = 1 To 5
    sheet3.Cells(lr3, k).Value = sheet1.Cells(lr3, k).Value
Next k


be this (you're not copying from row i on Sheet1) ?

For k = 1 To 5
    sheet3.Cells(lr3, k).Value = sheet1.Cells(i, k).Value
Next k


Would be faster as:

sheet3.Cells(lr3, 1).Resize(1, 5).Value = sheet1.Cells(i, 1).Resize(1, 5).Value


EDIT: this should be faster overall. Removes the nested loop and instead uses a dictionary to create a lookup on the sheet2 values.

Sub checkdata()

    Application.Calculation = xlCalculationManual
    Dim sheet1 As Worksheet, sheet2 As Worksheet, sheet3 As Worksheet
    Dim dict As Object, v

    Set sheet1 = Sheets(1)
    Set sheet2 = Sheets(2)
    Set sheet3 = Sheets(3)

    lr1 = sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    lr2 = sheet2.Cells(Rows.Count, 1).End(xlUp).Row
    lr3 = sheet3.Cells(Rows.Count, 1).End(xlUp).Row

    'Map all values+rows in Sheet2 ColD
    Set dict = CreateObject("scripting.dictionary")
    For j = 1 To lr2
        If sheet2.Cells(j, 5).Value = vbNullString Then
            v = jsheet2.Cells(j, 4).Value
            If Not dict.Exists(v) Then dict.Add v, j '&lt;&lt; capture value (first instance only) and row
        End If
    Next

    For i = 1 To lr1

        check = sheet1.Cells(i, 1).Value
        lr3 = lr3 + 1
        sheet3.Cells(lr3, 1).Resize(1, 5).Value = _
                sheet1.Cells(i, 1).Resize(1, 5).Value

        'does check exist on Sheet2 (with empty ColE value)?
        If dict.Exists(check) Then

            sheet2.Cells(dict(check), 9).Value = "x" '&lt;&lt;&lt; not Col 5 ?
            lr3 = lr3 + 1 '&lt;&lt;&lt; needed?
            sheet3.Cells(lr3, 6).Resize(1, 5).Value = _
                    sheet2.Cells(dict(check), 1).Resize(1, 5).Value
            Exit For
        End If

        lr3 = lr3 + 1 '&lt;&lt;&lt; needed?
    Next i

    Application.Calculation = xlCalculationAutomatic

End Sub