compare 2 sheet and all column if find duplicate will delete on sheet 2

[Teeroy]

Using .Find is a much quicker way of running this sort of check, otherwise you loop through the second sheet (no. of cells in sheet 1 range) times. Try the following on a COPY of your data first.

Sub DeleteMatchedRows()
Dim rSrc As Range, rTest As Range, rMatch As Range, rng As Range

Set rSrc = Intersect(Sheets("Sheet1").UsedRange, Sheets("Sheet1").Range("A1:Z1").EntireColumn)
For Each rng In rSrc
    Set rTest = Intersect(Sheets("Sheet2").UsedRange, Sheets("Sheet2").Range("A1:Z1").EntireColumn)
    If rTest.Cells.Count = 1 Then
        If rTest = "" Then Exit Sub
    End If
    Set rMatch = rTest.Find(rng.Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not rMatch Is Nothing Then
        Do
            rMatch.EntireRow.Delete
            Set rTest = Intersect(Sheets("Sheet2").UsedRange, Sheets("Sheet2").Range("A1:Z1").EntireColumn)
            If rTest.Cells.Count = 1 Then
                If rTest = "" Then Exit Sub
            End If
            Set rMatch = rTest.Find(rng.Value, after:=rTest.Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
        Loop While Not rMatch Is Nothing
    End If
Next
End Sub

Hope this helps.