Macro para ejecutar todos todas las celdas que tengan una cierta funcion

[nick_2014]

tengo la siguiente macro

Sub calcular_todo()

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = False

End Sub

Sub esta()

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

End Sub

Public Function f_EquipoResponde(str_Equipo As String) As String

Application.ScreenUpdating = False

Dim obj_Shell As Object

Dim obj_FileSystem As Object

Dim obj_Fichero As Object

Dim str_ContenidoFichero As String

Dim str_FicheroTemporal As String

Dim str_NombreMaquina As String

Set obj_Shell = CreateObject("WScript.Shell")

Set obj_FileSystem = CreateObject("Scripting.FileSystemObject")

str_FicheroTemporal = ThisWorkbook.Path & "\temp.txt"

obj_Shell.Run "cmd /c ping -a -n 2 -w 150 " & str_Equipo & " > """ & _

str_FicheroTemporal & """", 0, True

Set obj_Fichero = obj_FileSystem.OpenTextFile(str_FicheroTemporal, 1, False)

str_ContenidoFichero = obj_Fichero.ReadAll

obj_Fichero.Close

Set obj_Fichero = Nothing

obj_FileSystem.DeleteFile (str_FicheroTemporal)

Set obj_FileSystem = Nothing

Set obj_Shell = Nothing

Dim nombre As String

nombre = Mid(Replace(str_ContenidoFichero, vbCrLf, ""), 17, 10)

If InStr(str_ContenidoFichero, "perdidos = 0") > 0 Then

f_EquipoResponde = nombre & " ha RECIBIDOS 100%"

End If

If InStr(str_ContenidoFichero, "perdidos = 1") > 0 Then

f_EquipoResponde = nombre & "ha RECIBIDOS 50%"

End If

If InStr(str_ContenidoFichero, "perdidos = 2") > 0 Then

f_EquipoResponde = "IP VACANTE"

End If

End Function

MI IDEA ES QUE EN LA FUNCIÓN calcular_todo() se calcule todas las funciones llamadas f_EquipoResponde() dentro de todas las pestañas de excel . De antemano Muchas Gracias

[Armando Montes]

Hola, bienvendio al foro.

Los codigos debe usar etiquetas y debes subir un ejemplo con los resultados esperados.

Para mejor aprovechar el foro por favor lee y aplica las Normas AyudaExcel | Ayuda Excel