[a_axe]

в этом примере 4 группы и 3 измерения »

Elizavetta, я вижу 4 группы и 4 измерения

и соединять с соответствующей строкой »

"Соответствующая" - это какая? Что подразумевается под словом "соединять"?

Если я правильно понял пример - код должен быть вроде такого (запустите при активной странице с исходными данными). Если нет - приложите файл с листом-результатом работы кода, листом с правильным результатом выполненным вручную и дайте комментарии по несоответствию результатов. Код привязан к строчкам "Rank Sum - ", "гр = X,00, время = XX сутки" и "Описательные статистики", если этих фраз в файле не будет, или будут находится в произвольных местах - код нужно будет адаптировать.

код

Код:

Public Sub weres()
    Dim myCell As Range, DataRange As Range, fRange As Range
    Dim dataSht As Worksheet, targetSht As Worksheet
    Dim j As Long
    Dim strT1 As String, strT2 As String, strT3 As String
    
    Set dataSht = ActiveSheet
    Set targetSht = ActiveWorkbook.Worksheets.Add
    Set DataRange = dataSht.UsedRange
    
    For Each myCell In Intersect(DataRange, dataSht.Columns(3))
        If myCell.Text Like "Rank Sum - *" And myCell.Offset(0, 1).Text Like "Rank Sum - *" Then
            j = targetSht.UsedRange.Row + targetSht.UsedRange.Rows.Count + 1
            strT1 = Replace(myCell.Text, "Rank Sum - ", "")
            If strT1 Like "* *" Then strT1 = Left(strT1, InStr(strT1, " "))
            strT2 = Replace(myCell.Offset(0, 1).Text, "Rank Sum - ", "")
            If strT2 Like "* *" Then strT2 = Left(strT2, InStr(strT2, " "))
            strT3 = myCell.Offset(-1, -1).Value
            strT3 = Replace(Left(strT3, InStr(strT3, " ") - 1), "=", " = ")
            
            
            myCell.Offset(-1, -1).Copy targetSht.Cells(j, 2)
            Range(targetSht.Cells(j, 2), targetSht.Cells(j, 18)).Merge
            
            myCell.Offset(0, 2).Resize(4, 8).Copy targetSht.Cells(j + 1, 11)
            myCell.Offset(1, -1).Resize(3, 1).Copy targetSht.Cells(j + 2, 2)
            targetSht.Cells(j + 2, 3).Resize(3, 1).Value = strT1
            myCell.Offset(1, -1).Resize(3, 1).Copy targetSht.Cells(j + 5, 2)
            targetSht.Cells(j + 5, 3).Resize(3, 1).Value = strT2
            
            Set fRange = dataSht.Cells.Find(strT3 & ",00, время = " & strT1)
            If Not (fRange.Offset(2, 0).Text Like "Описательные статистики*") Then
                Set fRange = dataSht.Cells.FindNext(After:=fRange)
            End If
            fRange.Offset(3, 1).Resize(1, 7).Copy targetSht.Cells(j + 1, 4)
            fRange.Offset(4, 5).Resize(1, 2).Copy targetSht.Cells(j + 1, 8)
            fRange.Offset(5, 1).Resize(3, 7).Copy targetSht.Cells(j + 2, 4)
            Set fRange = dataSht.Cells.Find(strT3 & ",00, время = " & strT2)
            If Not (fRange.Offset(2, 0).Text Like "Описательные статистики*") Then
                Set fRange = dataSht.Cells.FindNext(After:=fRange)
            End If
            fRange.Offset(5, 1).Resize(3, 7).Copy targetSht.Cells(j + 5, 4)
            
        End If
    Next myCell
    
    Set DataRange = Nothing
    Set dataSht = Nothing
    Set targetSht = Nothing
    Set fRange = Nothing
End Sub