For Each x In arr
        wsStat.Range("B3").Value = x
        Call Sheet1.refresh_select
        'дополняем лист "Должно так выходить"
        Set rr = wsStat.Range("U35:X49")
        For lr = 1 To rr.Rows.Count
            s = rr.Cells(lr, 2).Value
            If s <> "" Then
                asSp = Split(s, " - ", 2)
                If UBound(asSp) > 0 Then
                    arr2 = wsStat.Range("Q6:Q36").Value
                    s1 = LCase(Trim(asSp(0)))
                    s2 = LCase(Trim(asSp(1)))
                    For Each xx In arr2
                        If LCase(Trim(xx)) = s1 Then
                            wsStat.Range("C7").Value = xx
                        End If
                        If LCase(Trim(xx)) = s2 Then
                            wsStat.Range("D7").Value = xx
                        End If