I've written a Macro for making a dictionary from a book...

It takes phrases imported to excel, and cuts them to individual words, so that I can put the meaning in each celd

The problem is IT WOULD TAKE ME 16 HOURS TO DO IT WITH A BOOK...

Do you know any way to optimize it? A already setted of the ScreenUpdating

THANK YOUU



----------------

My Code is as follows

It takes words from

Texto de prueba to Lista de pabras


----------------------------

Sub UNOTRASPASARSINDUPLICADOS()
Application.ScreenUpdating = False


Dim B As Integer

Dim A As Boolean

For B = 1 To 10

A = ((Worksheets("Texto de prueba").Range("A1")) = "")

If A Then
B = 11
Else
Dim palabra As Integer

Worksheets("Texto de prueba").Range("B1").FormulaR1C1 = "=FIND("" "",RC[-1])"
Worksheets("Texto de prueba").Range("C1").FormulaR1C1 = "=LEFT(RC[-2],RC[-1])"
Worksheets("Texto de prueba").Range("D1").FormulaR1C1 = "=LEN(RC[-3])"

For palabra = 1 To 1000


C = IsError(Worksheets("Texto de prueba").Range("A1"))


If (C) Then
palabra = 1001

Else

Worksheets("Lista de pabras").Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' If Worksheets("Texto de prueba").Range("A1:A5000").Find(Worksheets("Texto de prueba").Range("C1")) Then
Worksheets("Texto de prueba").Range("C1").Copy
Worksheets("Lista de pabras").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

End If

Worksheets("Texto de prueba").Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Worksheets("Texto de prueba").Range("A1").FormulaR1C1 = "=RIGHT(RC[1],RC[4]-RC[2])"
Worksheets("Texto de prueba").Range("A1").Copy
Worksheets("Texto de prueba").Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Texto de prueba").Columns("A:A").Delete Shift:=xlToLeft
Application.CutCopyMode = False




Next palabra

If IsError(Worksheets("Lista de pabras").Range("A1")) Then
Worksheets("Lista de pabras").Rows("1:1").Delete Shift:=xlUp
End If

Worksheets("Texto de prueba").Rows("1:1").Delete Shift:=xlUp


End If


Next B

Application.ScreenUpdating = True



End Sub