Sub compare5()

Set Target = ThisWorkbook.Sheets( 1 ).UsedRange.Columns( 2 ).Cells

For Each cc In Target 'цикл по используемым ячейкам втрой колонки
a = cc.Rows.Row 'номер ряда анализируемй ячейки
flag =  0  'флаг совпадения

Set x = ThisWorkbook.Sheets( 1 ).Columns( 6 ).Find(ThisWorkbook.Sheets( 1 ).Cells(a,  2 ), _
    LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True) 'поиск полного совпадения _
    по  6 -ой колонке значения из  2 -ой колонки  1 -го файла
    
If x Is Nothing Then ' если не нашли, уходим на след.поиск
GoTo goout
Else
    iFirstAddress = x.Address 'запоминаем адрес первого совпадения
    
            If Cells(a,  3 ).Value = Cells(x.Rows.Row,  7 ).Value Then
            flag =  1  'если пара совпадает, ставим пометку
            GoTo goout  ' уходим на след.поиск
            End If
            
    Do ' запускаемся на поиск след.совпадений
    Set x = ThisWorkbook.Sheets( 1 ).Columns( 6 ).FindNext(x)
    iSecondAddress = x.Address 'запоминаем адрес следующего совпадения
    
        If Cells(a,  3 ).Value = Cells(x.Rows.Row,  7 ).Value Then
        flag =  1  'если пара совпадает, ставим пометку и
        Exit Do ' выходим в итоге совсем из поиска
        End If
        
    Loop While iFirstAddress <> iSecondAddress 'ищем, пока не вернёмся на первое совпадение
    
End If

goout: 'процедура выхода из цикла поиска
If flag =  0  Then _
Cells(a,  4 ).Value = Cells(a,  1 ).Value & " " & Cells(a,  2 ).Value & " " & Cells(a,  3 ).Value
        'если нет результата поиска или пара не совпадает, тогда пишем пометку в 4-ю ячейку
Next 'следующая ячейка

End Sub

Sub kraus()
      iValue = "Группа:"
      
For Each iList In Worksheets

Set iFinds = iList.UsedRange.Find(iValue, LookIn:=xlValues)

If Not iFinds Is Nothing Then

iFirstAddress = iFinds.Address
        
Do

'сюда надо прикрутить Ваш код:
'Set obj1 = .Cells.Find("Группа:") - это меняем на
Set obj1 = iFinds
obj1.Font.Bold = True
obj1.Font.Size =  14 

iFindValue = iFindValue & vbCrLf & iList.Name & " - " & iFinds.Address & " - " & iFinds.Value
iCount = iCount +  1 

Set iFinds = iList.UsedRange.FindNext(iFinds)

Loop While Not iFinds Is Nothing And iFinds.Address <> iFirstAddress
    
End If

Next

If iCount >  0  Then

MsgBox iFindValue, , "Количество найденных совпадений : " & iCount
End If

End Sub

Sub KrausShort()
      iValue = "Группа:"
      
Set iFinds = ActiveSheet.UsedRange.Find(iValue, LookIn:=xlValues)

If Not iFinds Is Nothing Then

iFirstAddress = iFinds.Address
        
Do
Set obj1 = iFinds
obj1.Font.Bold = True
obj1.Font.Size =  14 

Set iFinds = ActiveSheet.UsedRange.FindNext(iFinds)

Loop While Not iFinds Is Nothing And iFinds.Address <> iFirstAddress
    
End If

End Sub

Debug.Print iFinds
Debug.Print iFirstAddress

Группа:
$I$ 22 

Sub tt()
Dim str As Variant
str = "Дата: Z2"
str = Left(str,  6 ) & Format(Now(), "DD.MM.YYYY")
MsgBox str

End Sub