Sub Cub()
Dim shRun, arr, k, lk
    Application.ScreenUpdating = False
    On Error Resume Next
    Range("Кубок").ClearContents
    Sheets("Кубок").ListObjects("Кубок").Unlist
    iList = Array("Ринг_сх", "Ринг_С_сх", "ТАТАМІ_1_сх", "ТАТАМІ_2_сх")
    lk = 1 + Sheets("Кубок").Range("A65535").End(xlUp).Row
    For Each Sh In iList
        Set shRun = Worksheets(Sh)
        LR = shRun.[R10000].End(xlUp).Row
        For i = 2 To LR
            d = shRun.Cells(i, 18).Address
            If IsEmpty(shRun.Cells(i, 18)) = False Then
                For k = 1 To 20
                arr = "=" & shRun.Name & "!" & shRun.Range(d).Offset(0, k - 1).Address
                Sheets("Кубок").Cells(lk, k).Value = arr
                Next k
            lk = lk + 1
            End If
            'Worksheets(Sh).Select
        Next i
    Next Sh
    'Worksheets("Кубок").Select
    x = Worksheets("Кубок").Range("A65535").End(xlUp).Row
    Worksheets("Кубок").ListObjects.Add(xlSrcRange, Range("$A$1" & ":$T" & x), xlYes).Name = "Кубок"
    Worksheets("Кубок").Range("Кубок[#All]").Select
    Worksheets("Кубок").ListObjects("Кубок").TableStyle = "TableStyleLight9"
    Application.ScreenUpdating = True
    MsgBox "работа завершенна"
End Sub