Hola.

Quiero hacer una macro que me busque el número de veces que se repite unas palabra en un documento de word y que ese número lo pase a una tabla bien de Word o de Excel.

Sé que se puede hacer desde Word yendo a Buscar y poniendo la palabra, al tratarse de bastantes palabras intentaba que se pudiera crear una macro para que busque esas palabras y me lo pase el número a tabla.

Un saludo y gracias

He encontrado en la web (https://wordribbon.tips.net/) dos soluciones que más o menos se ajustan a lo que pedía y las voy a poner aquí por si le sirven a alguien.

La primera es una macro que al ejecutarla te irá saliendo una ventana para que indiques la palabra que buscas y una vez le das a Aceptar te muestra las veces que se repite esa palabra, al volver a dar Aceptar te vuelve a salir la ventana para buscar otra palabra. Cuando ya no se quiere buscar más se le da a cancelar. La pena es que no te crea un documento nuevo con la lista de palabras buscadas y las veces que se repitan, eso ya sería la repera.

Sub FindWords()
Dim sResponse As String
Dim iCount As Integer

' Input different words until the user clicks cancel
Do
' Identify the word to count
sResponse = InputBox( _
Prompt:="¿Qué palabra quieres contar?", _
Title:="Contar palabras", Default:="")

If sResponse > "" Then
' Set the counter to zero for each loop
iCount = 0
Application.ScreenUpdating = False
With Selection
.HomeKey Unit:=wdStory
With .Find
.ClearFormatting
.Text = sResponse
' Loop until Word can no longer
' find the search string and
' count each instance
Do While .Execute
iCount = iCount + 1
Selection.MoveRight
Loop
End With
' show the number of occurences
MsgBox sResponse & " appears " & iCount & " times"
End With
Application.ScreenUpdating = True
End If
Loop While sResponse <> ""
End Sub


Y la segunda lo que hace es buscar todas las palabras de un documento e indicar cuántas veces se repite, esta lista se añade a un documento nuevo.

Sub AAAWordFrequency()
Const maxwords = 9000 'Maximum unique words allowed
Dim SingleWord As String 'Raw word pulled from doc
Dim Words(maxwords) As String 'Array to hold unique words
Dim Freq(maxwords) As Integer 'Frequency counter for unique words
Dim WordNum As Integer 'Number of unique words
Dim ByFreq As Boolean 'Flag for sorting order
Dim ttlwds As Long 'Total words in the document
Dim Excludes As String 'Words to be excluded
Dim Found As Boolean 'Temporary flag
Dim j, k, l, Temp As Integer 'Temporary variables
Dim ans As String 'How user wants to sort results
Dim tword As String '
Dim aword As Object '
Dim tmpName As String '

' Set up excluded words
Excludes = "[the][a][of][is][to][for][by][be][and][are]"

' Find out how to sort
ByFreq = True
ans = InputBox("Sort by WORD or by FREQ?", "Sort order", "WORD")
If ans = "" Then End
If UCase(ans) = "WORD" Then
ByFreq = False
End If

Selection.HomeKey Unit:=wdStory
System.Cursor = wdCursorWait
WordNum = 0
ttlwds = ActiveDocument.Words.Count

' Control the repeat
For Each aword In ActiveDocument.Words
SingleWord = Trim(LCase(aword))
'Out of range?
If SingleWord < "a" Or SingleWord > "z" Then
SingleWord = ""
End If
'On exclude list?
If InStr(Excludes, "[" & SingleWord & "]") Then
SingleWord = ""
End If
If Len(SingleWord) > 0 Then
Found = False
For j = 1 To WordNum
If Words(j) = SingleWord Then
Freq(j) = Freq(j) + 1
Found = True
Exit For
End If
Next j
If Not Found Then
WordNum = WordNum + 1
Words(WordNum) = SingleWord
Freq(WordNum) = 1
End If
If WordNum > maxwords - 1 Then
j = MsgBox("Too many words.", vbOKOnly)
Exit For
End If
End If
ttlwds = ttlwds - 1
StatusBar = "Remaining: " & ttlwds & ", Unique: " & WordNum
Next aword

' Now sort it into word order
For j = 1 To WordNum - 1
k = j
For l = j + 1 To WordNum
If (Not ByFreq And Words(l) < Words(k)) _
Or (ByFreq And Freq(l) > Freq(k)) Then k = l
Next l
If k <> j Then
tword = Words(j)
Words(j) = Words(k)
Words(k) = tword
Temp = Freq(j)
Freq(j) = Freq(k)
Freq(k) = Temp
End If
StatusBar = "Sorting: " & WordNum - j
Next j

' Now write out the results
tmpName = ActiveDocument.AttachedTemplate.FullName
Documents.Add Template:=tmpName, NewTemplate:=False
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
For j = 1 To WordNum
.TypeText Text:=Trim(Str(Freq(j))) _
& vbTab & Words(j) & vbCrLf
Next j
End With
System.Cursor = wdCursorNormal
j = MsgBox("There were " & Trim(Str(WordNum)) & _
" different words ", vbOKOnly, "Finished")

End Sub

Espero que a alguien le pueda servir. Un saludo