Buenos días,
Resulta que estoy usando una macro y cuando la ejecuto me sale una
pantallita con ese error "Suscript out of range".
Esta macro está elaborada por el equipo técnico de la empresa... tenemos un
lugar en la intranet para macros, ahí entramos, copiamos el código de la que
nos interese, y la pegamos y ejecutamos en el fichero que estemos usando.
Se da la circunstancia de que esta misma macro la usa más gente y no tienen
problemas...
El nivel de seguridad de macros está establecido en bajo...
La macro en cuestión es así:
Const FirstErrorMessageRowNumber As Integer = 3
Dim CurrentErrorMessageRowNumber As Long
Sub DuplicateFilter()
On Error GoTo Err:
Dim i As Long, sPreviousWord As String, sCurrentWord As String
If MsgBox("Do you wish to run the Duplicate Filter?", vbYesNo,
"Espotting Duplicate Filter") = vbNo Then
Exit Sub
End If
'Set Up Variables
i = 1
CurrentErrorMessageRowNumber = FirstErrorMessageRowNumber
'Sort the List to make finding duplicates Easy...
Workbooks(1).Worksheets(1).Range("A1:G65000").Sort
key1:=Workbooks(1).Worksheets(1).Range("A1")
Do While Not IsEmpty(Workbooks(1).Worksheets(1).Cells(i, 1))
sPreviousWord = sCurrentWord
sCurrentWord = Workbooks(1).Worksheets(1).Cells(i, 1).Value
If sPreviousWord = sCurrentWord Then 'Delete Current Word
DeleteRow (i)
End If
i = i + 1
Loop
'Write a nice message at the top of Sheet 2
Workbooks(1).Worksheets(2).Cells(1, 1).Value = "Espotting Duplicate
Filter Macro Ran on " & CStr(i) & " rows."
'Sort the List to Get rid of Blank Rows
Workbooks(1).Worksheets(1).Range("A1:G65000").Sort
key1:=Workbooks(1).Worksheets(1).Range("A1")
'Send a Message to say all done...
MsgBox "All Finished", vbOKOnly, "Duplicate Filter Macro"
Exit Sub
Err:
MsgBox Err.Description
End Sub
'Write Error And the Whole line to the Second Spread Sheet
Sub DeleteRow(iRowNumber As Long)
On Error GoTo Err:
If CurrentErrorMessageRowNumber = FirstErrorMessageRowNumber Then 'First
Error
Workbooks(1).Worksheets(2).Cells(2, 1).Value = "Keyword"
Workbooks(1).Worksheets(2).Cells(2, 2).Value = "Url"
Workbooks(1).Worksheets(2).Cells(2, 3).Value = "Title"
Workbooks(1).Worksheets(2).Cells(2, 4).Value = "Description"
Workbooks(1).Worksheets(2).Cells(2, 5).Value = "Bid"
Workbooks(1).Worksheets(2).Cells(2, 6).Value = "Display Url"
End If
'Copy the Lines to the Error Sheet
Workbooks(1).Worksheets(2).Cells(CurrentErrorMessageRowNumber, 1).Value
= Workbooks(1).Worksheets(1).Cells(iRowNumber, 1).Value
Workbooks(1).Worksheets(2).Cells(CurrentErrorMessageRowNumber, 2).Value
= Workbooks(1).Worksheets(1).Cells(iRowNumber, 2).Value
Workbooks(1).Worksheets(2).Cells(CurrentErrorMessageRowNumber, 3).Value
= Workbooks(1).Worksheets(1).Cells(iRowNumber, 3).Value
Workbooks(1).Worksheets(2).Cells(CurrentErrorMessageRowNumber, 4).Value
= Workbooks(1).Worksheets(1).Cells(iRowNumber, 4).Value
Workbooks(1).Worksheets(2).Cells(CurrentErrorMessageRowNumber, 5).Value
= Workbooks(1).Worksheets(1).Cells(iRowNumber, 5).Value
Workbooks(1).Worksheets(2).Cells(CurrentErrorMessageRowNumber, 6).Value
= Workbooks(1).Worksheets(1).Cells(iRowNumber, 6).Value
CurrentErrorMessageRowNumber = CurrentErrorMessageRowNumber + 1
'Delete The Lines
Workbooks(1).Worksheets(1).Cells(iRowNumber, 1).Value = ""
Workbooks(1).Worksheets(1).Cells(iRowNumber, 2).Value = ""
Workbooks(1).Worksheets(1).Cells(iRowNumber, 3).Value = ""
Workbooks(1).Worksheets(1).Cells(iRowNumber, 4).Value = ""
Workbooks(1).Worksheets(1).Cells(iRowNumber, 5).Value = ""
Workbooks(1).Worksheets(1).Cells(iRowNumber, 6).Value = ""
Exit Sub
Err:
MsgBox Err.Description
End Sub
¿Sabéis cuál puede ser el motivo, qué significa ese error y cómo solucionarlo?
Gracias mil!
Marta
Leer las respuestas