Public Sub Распред()
T = Timer

For Each sh In Sheets
sh.Cells(1, 1).Value = "Фраза"
Next sh

Dim mainstring As String
Dim my_data(2 To 18544) As Variant

    For j = 2 To 18544
        my_data(j) = Sheets(1).Cells(j, 1)
    Next j
    
    For i = 2 To 225
    mainstring = Sheets(1).Cells(i, 2)
    
        For j = 2 To 18544    
            If my_data(j) = mainstring Then
                Sheets().Cells(j, 1) = Sheets(1).Cells(j, 1)
                Debug.Print "Соотносится = " & j
            End If
        Next i
    Next j

Debug.Print Timer - T
MsgBox "Я всё сделал!"
End Sub

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    Sheets(Range("B" & i).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Range("A" & i).Value
Next i