Formula be replaced with macro

[K0st4din]

Hello,
can anyone tell me and help whether this kind of formula can be replaced by macro and perform the same function. This is just an example, then I will change my columns.
The idea is to search in one column (chosen by me) and the string of text, if I find search terms to bring them back again for each row in another column.
For example, looking at column A2:A and returns in column B2:B

=REPLACE(REPT("+AF266";COUNTIF(A2;"*AF266*"))&REPT("+AF267";COUNTIF(A2;"*AF267*"))&REPT("+AF268";COUNTIF(A2;"*AF268*"))&REPT("+AF269";COUNTIF(A2;"*AF269*"))&REPT("+AF311";COUNTIF(A2;"*AF311*"))&REPT("+CF706";COUNTIF(A2;"*CF706*"))&REPT("+CF707";COUNTIF(A2;"*CF707*"))&REPT("+CF708";COUNTIF(A2;"*CF708*"))&REPT("+CF512";COUNTIF(A2;"*CF512*"))&REPT("+CF508";COUNTIF(A2;"*CF508*"))&REPT("+CF437";COUNTIF(A2;"*CF437*"))&REPT("+CF648";COUNTIF(A2;"*CF648*"))&REPT("+CF649";COUNTIF(A2;"*CF649*"))&REPT("+CF444";COUNTIF(A2;"*CF444*"))&REPT("+HF095";COUNTIF(A2;"*HF095*"))&REPT("+NF520";COUNTIF(A2;"*NF520*"))&REPT("+NF521";COUNTIF(A2;"*NF521*"))&REPT("+NF522";COUNTIF(A2;"*NF522*"))&REPT("+NF523";COUNTIF(A2;"*NF523*"))&REPT("+AF386";COUNTIF(A2;"*AF386*"));1;1;"")

Thanks in advance.

 

[K0st4din]

Hello Sir ,
I would like to ask where is my mistake : Thanks to you and your colleagues to reach the final of my excel file. And now that I have all macros starting to organize and set them according to my wishes.
But for some reason have something that in any way I can not explain to myself.
Here is my question : In the different modules , I put the same macro - BUT with different names and different columns . At one point the macro starting to DELETE VERY different columns in which I have written quite different things .
What caused this error , sir?

Sub Terapia_Nereimburs()  
Dim X As Long, Cell As Range, CellText As String, ws As Worksheet
  Dim Words As Variant, Replacements As Variant
  Const TableSheetName As String = "Sheet1"
  Application.Volatile
  Words = Sheets(TableSheetName).Range("R2", Sheets(TableSheetName).Cells(Rows.Count, "R").End(xlUp))
    Replacements = Sheets(TableSheetName).Range("S2", Sheets(TableSheetName).Cells(Rows.Count, "S").End(xlUp))
    For Each ws In Worksheets
    For Each Cell In ws.Range("J2", ws.Cells(Rows.Count, "J").End(xlUp))
    CellText = ""
      For X = 1 To UBound(Words)
        If InStr(1, Cell.Value, Words(X, 1), vbTextCompare) Then CellText = CellText & "+" & Replacements(X, 1)
      Next
      Cell.Offset(, 2).Value = Mid(CellText, 2) 'Terapia_Nereimburs L
    Next
  Next
End Sub

Sub Specialnosti()  
Dim X As Long, Cell As Range, CellText As String, ws As Worksheet
  Dim Words As Variant, Replacements As Variant
  Const TableSheetName As String = "Sheet1"
  Application.Volatile
  Words = Sheets(TableSheetName).Range("AA2", Sheets(TableSheetName).Cells(Rows.Count, "AA").End(xlUp))
    Replacements = Sheets(TableSheetName).Range("Z2", Sheets(TableSheetName).Cells(Rows.Count, "Z").End(xlUp))
    For Each ws In Worksheets
    For Each Cell In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
    CellText = ""
      For X = 1 To UBound(Words)
        If InStr(1, Cell.Value, Words(X, 1), vbTextCompare) Then CellText = CellText & "+" & Replacements(X, 1)
      Next
      Cell.Offset(, 17).Value = Mid(CellText, 2) 'Specialnosti
    Next
  Next
End Sub

Sub Lechebno_zavedenie()  
Dim X As Long, Cell As Range, CellText As String, ws As Worksheet
  Dim Words As Variant, Replacements As Variant
  Const TableSheetName As String = "Sheet1"
  Application.Volatile
  Words = Sheets(TableSheetName).Range("AA2", Sheets(TableSheetName).Cells(Rows.Count, "AA").End(xlUp))
    Replacements = Sheets(TableSheetName).Range("AE2", Sheets(TableSheetName).Cells(Rows.Count, "AE").End(xlUp))
    For Each ws In Worksheets
    For Each Cell In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
    CellText = ""
      For X = 1 To UBound(Words)
        If InStr(1, Cell.Value, Words(X, 1), vbTextCompare) Then CellText = CellText & "+" & Replacements(X, 1)
      Next
      Cell.Offset(, 20).Value = Mid(CellText, 2) 'Lechebno zavedenie
    Next
  Next
End Sub

I showed you some of the macros are generally made ​​the same thing but with different names and different columns and as I can not explain how looking in column AA starting to erase written in column R. has nothing to do with the default values​​.

 

[K0st4din]

Assumed that sheet1 is the list of my database in different columns I have different information to be distributed by all the other sheets according to my wishes and columns. Ie I have 17 buttons and a few of them I've put some of these almost identical macros.