Sub Swimingpool()
'
' Swimming pool Makro
'
'

Dim policka(100) As String
numberofwords = 29
For i = 1 To numberofwords
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "+"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    policka(i * 2 - 1) = Selection
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    policka(i * 2) = Selection
    Selection.TypeParagraph
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "+"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    
    Next
   
     Set myrange = ActiveDocument.Range(0, 0)
ActiveDocument.Tables.Add Range:=myrange, NumRows:=25, NumColumns:=3
 With ActiveDocument.Tables(1)
        If .Style <> "Møížka tabulky" Then
            .Style = "Møížka tabulky"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
End With
cislopolicka = 0

 For i = 1 To 25
    For y = 1 To 3
cislopolicka = Int(numberofwords * Rnd) + 1
ActiveDocument.Tables(1).Cell(i, y).Range.InsertAfter policka(cislopolicka * 2)
  
Next y
Next i
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "+"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub