Sub Sravnenie()
Dim object, times
Dim plan As Object, gos As Object, result As Object, x As Range
Dim FirstAddress$, blank_cell As Range
Dim discipl As Range
Worksheets("Лист3").Cells.ClearContents
Set plan = Sheets( 2 )
Set gos = Sheets( 1 )
Set result = Sheets( 3 )

For Each discipl In plan.UsedRange.Columns( 2 ).Cells

object = discipl.Value
times = plan.Cells(discipl.Row,  8 ).Value

    If object <> "" Then
        If object Like "ДС*" Or object Like "ФТД*" Then
                Set DS_FTD = plan.Cells(discipl.Row,  3 )
                Set x = gos.Columns( 2 ).Find(DS_FTD, LookIn:=xlValues, lookat:=xlPart, MatchCase:=True)
                Set object = plan.Columns( 2 ).Find("Всего по ДС*")
        Else
            Set x = gos.Columns( 2 ).Find(object, LookIn:=xlValues, lookat:=xlPart, MatchCase:=True)
        
        
        If Not x Is Nothing Then
        
            FirstAddress = x.Address
                    
            Do
                Set x = gos.Columns( 2 ).FindNext(x)
                    If gos.Cells(x.Row,  3 ).Value <> times Then
                            Set blank_cell = result.Cells(result.Range("a" & Rows.Count).End(xlUp).Row +  1 ,  1 )
                            plan.Cells(discipl.Row,  2 ).Copy blank_cell
                    End If
            Loop While Not x Is Nothing And x.Address <> FirstAddress
        Else
                Set blank_cell = result.Cells(result.Range("a" & Rows.Count).End(xlUp).Row +  1 ,  1 )
                plan.Cells(discipl.Row,  2 ).Copy blank_cell
                'blank_cell.Offset(0, 2).Value = "Not Exist In Sheets1 Column2!"
        End If
        End If
    End If
Next

ActiveSheet.Columns.AutoFit
ActiveSheet.Rows.AutoFit

End Sub

For i =  1  To plan.UsedRange.Rows.Count

Set object = plan.Columns( 2 ).Find("Всего*", Cells(i,  2 ))