Cambiar un dato de una fórmula en toda la carpeta

Tengo una carpeta con bastantes archivos de excel, lo que necesito que me haga la macro seria lo siguiente, en todos los archivos de excel que tiene el libro que me busque este dato $F$21 por este otro dato $F$1000

1 respuesta

Respuesta
2

Prueba esto:

Sub Reemplazar_En_Formulas()
'Por Dante Amor
  Dim wb As Workbook
  Dim sh As Worksheet
  Dim ruta As String
  Dim arch As String
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  ruta = "C:\trabajo\"
  If Dir(ruta, vbDirectory) = "" Then
    MsgBox "La ruta no existe"
    Exit Sub
  End If
  '
  arch = Dir(ruta & "*.xls*")
  Do While arch <> ""
    Set wb = Workbooks.Open(ruta & arch)
    For Each sh In wb.Sheets
      sh.Cells.Replace "$F$21", "$F$1000", xlPart, xlByRows, False, False, False
    Next
    wb.Close True
    arch = Dir()
  Loop
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  MsgBox "Fin"
End Sub

Cambia la carpeta por el folder donde tienes tus archivos.

Muchísimas gracias, esta perfecto.

Un pregunta más, estos archivos se alimentan de otros archivos de excel, y lo que he observado que si tengo abierto los archivos de los cuales cogen datos, al guardarse los datos me ocupa más o menos 2000kb, pero si están cerrados ocupan 6000kb. ¿Conoces alguna manera para que al guardar el archivo me ocupe lo mínimo posible sin tener que tener abiertos 8 excels más?

Tendrás que revisar archivo por archivo para eliminar las filas o las columnas que no necesitas, de esa manera tendrás más depurado cada hoja y por ende cada libro.

Quite todas las filas y columnas que me sobraban y quite también formatos condicionales.

Lo raro es que si están abiertos ocupen mucho menos, que cuando no lo están

Dante Amor, se me olvido decirte que si hay posibilidad que en la macro en vez de poner yo la ruta, la coja automáticamente de la carpeta donde tengo los archivos

ruta = "C:\trabajo\"

¿El archivo con la macro está en la misma carpeta de los archivos?

si

Prueba esto.

Sub Reemplazar_En_Formulas()
'Por Dante Amor
  Dim wb As Workbook
  Dim sh As Worksheet
  Dim ruta As String
  Dim arch As String
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  ruta = ThisWorkbook.Path & "\"
  arch = Dir(ruta & "*.xls*")
  Do While arch <> ""
    If LCase(arch) <> LCase(ThisWorkbook.Name) Then
      Set wb = Workbooks.Open(ruta & arch)
      For Each sh In wb.Sheets
        sh.Cells.Replace "$F$21", "$F$1000", xlPart, xlByRows, False, False, False
      Next
      wb.Close True
    End If
    arch = Dir()
  Loop
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  MsgBox "Fin"
End Sub

Muchas Gracias! 

Encantado de ayudarte, gra cias por comentar.

Es importante esta línea para que no abra el mismo archivo con la macro y lo cierre.

If LCase(arch) <> LCase(ThisWorkbook.Name) Then

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas