Sub Макрос1()
    Dim i&, j&, lRow&, lRow2&
    Dim arr, arr2
    Application.ScreenUpdating = False

    
    With Sheets("Таблица")
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("C2:C" & lRow).FormulaR1C1 = "=LEN(RC[-2])"
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("C2:C" & lRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .SetRange Range("A2:C" & lRow)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        arr = .Range("A2:B" & lRow).Value
    End With
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual
    With Sheets("Лист1")
        lRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
        arr2 = .Range("A2:B" & lRow2).Value
    End With
    
    For j = LBound(arr2) To UBound(arr2)
        For i = LBound(arr) To UBound(arr)
            If (arr2(j, 1) Like arr(i, 1) & "*") Then
                arr2(j, 2) = arr(i, 2)
                Exit For
            End If
        Next i
        
        With Application
            .StatusBar = j
        End With
    Next j
'
'    For i = LBound(arr) To UBound(arr)
'        For j = LBound(arr2) To UBound(arr2)
'            If (arr2(j, 1) Like "*" & arr(i, 1) & "*") And arr2(j, 2) = "" Then
'                arr2(j, 2) = arr(i, 2)
'            End If
'            If (Sheets("Лист1").Cells(j, "A") Like "*" & Sheets("Таблица").Cells(i, "A") & "*") And _
'                Sheets("Лист1").Cells(j, "B") = "" Then
'                Sheets("Лист1").Cells(j, "B") = Sheets("Таблица").Cells(i, "B")
'            End If
'        Next j
'    Next i
    
    Sheets("Лист1").Range("A2:B" & lRow2) = arr2
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
    
    With Sheets("Таблица")
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("B2:B" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A2:C" & lRow)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Columns(3).ClearContents
    End With

    Application.ScreenUpdating = True
End Sub

 =ЕСЛИОШИБКА(ВПР(A2;Таблица!$A$2:$B$1499;2;ЛОЖЬ);"")

Sub Repair_LAT2()   ' C W U 0 0 X I P L M Z S A G K B X
   With ActiveSheet.UsedRange
      If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
      Application.ScreenUpdating = False: Application.EnableEvents = False
      Dim arrENG: arrENG = Split("C W U 0 0 X I P L M Z S A G K B X Y")
      Dim arrRUS: arrRUS = Split("С Ц Г Й Щ Х Ш З Д Ь Я Ы Ф П Л И Ч У")
      Dim i%
      For i = 0 To UBound(arrENG)
         Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _
               What:=arrRUS(i), Replacement:=arrENG(i), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
      Next i
   End With
   Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

let
    Source= Web.Page(Web.Contents("http://доменноеимя.ком/тут раздел/тут таблица1/)),
    Data0 = Source{0}[Data]
in
    Data0

Далее я так понимаю мне нужна команда "then", но power query на неё ругается


let
    Source= Web.Page(Web.Contents("http://доменноеимя.ком/тут раздел/тут таблица2/)),
    Data1 = Source{1}[Data]
in
    Data1

Sub Color_RUS_LAT()   ' выделить русские символы в Selection ЗЕЛЁНЫМ, латинские - КРАСНЫМ   With ActiveSheet.UsedRange
      If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
      Dim rCell As Range, i%, iColor%, ch$
      With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
      For Each rCell In Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants))
         For i = 1 To Len(rCell)
            ch = LCase(Mid(rCell, i, 1))
            iColor = IIf(ch Like "[а-яё]", 10, IIf(ch Like "[a-z]", 3, xlColorIndexAutomatic))   ' 10 - цвет символов РУС, 3 - цвет символов LAT
            rCell.Characters(i, 1).Font.ColorIndex = iColor
         Next i
      Next rCell
      With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic: End With
   End With
End Sub

Sub Color_RUS_LAT()   ' выделить русские символы в Selection ЗЕЛЁНЫМ, латинские - КРАСНЫМ   With ActiveSheet.UsedRange
      If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
      Dim rCell As Range, i%, iColor%, ch$
      With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
      For Each rCell In Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants))
         For i = 1 To Len(rCell)
            ch = LCase(Mid(rCell, i, 1))
            iColor = IIf(ch Like "[а-яё]", 10, IIf(ch Like "[a-z]", 3, xlColorIndexAutomatic))   ' 10 - цвет символов РУС, 3 - цвет символов LAT
            rCell.Characters(i, 1).Font.ColorIndex = iColor
         Next i
      Next rCell
      With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic: End With
   End With
End Sub