Saltar al contenido

Extraer informacion de una celda de varios archivos excel


Recommended Posts

publicado

Buenos días

escribo en esta ocasión para que me guíen puesto que deseo extraer la información de 400 informes, pero solo algunas celdas, la celda en este caso es C18 de todos los archivos, en este momento solo necesito esa celda, pero pronto necesitare sacar la información de otras que aun no conozco. Todos los informes tienen la misma estructura, necesito saber como luego de tener el codigo macro VBA, como irlo modificando de acuerdo a la necesidad de celda.

Saludos

PD: vi un post muy parecido en el cual tratan lo mismo pero no se como modificar el codigo. el codigo que sale en el post es el siguiente:

Option Explicit

Sub RecuperaDatoA2_y_I2_Opcion_1()

'Usando función de Macro de Excel4 (predecesor de VBA) [Macrofucion]

Dim ruta_directorio, archivo As String, NombreArchivo As String, NombreHoja

Dim n As Long

'Indicas la Ruta base, estoy suponiendo que los 4000 archivos estan en el mismo directorio

ruta_directorio = ObtieneRutaCarpeta '[uso la función auxiliar para que la puedas elegir]

If TypeName(ruta_directorio) = "Boolean" Then Exit Sub 'Si se presiona cancelar sale del proceso

'Inputbox para indicar nombre de hoja

NombreHoja = Application.InputBox("¿Cómo se llama la hoja dónde estan los datos?" & vbNewLine & vbNewLine & _

"Toma en cuenta que debe estar escrito exatamente igual, es decir considerando mayúsculas y minusculas", _

"Indica Nombre de la Hoja que tiene los datos en cada libro", "ANIMADOR", , , , , 2)

If TypeName(NombreHoja) = "Boolean" Then Exit Sub

If VBA.Right(ruta_directorio, 1) <> Application.PathSeparator Then ruta_directorio = ruta_directorio & Application.PathSeparator

Columns("A:B").Clear 'Borra el contenido anterior

n = 1

With Range("A1:B1")

.Value = Array("Nombre de archivo", "Nombre de UDS")

.Interior.Color = vbGreen

End With

'Se inicia el recorrido y se cargan los datos en la hoja

'para archivos excel 97-2007

NombreArchivo = Dir(ruta_directorio & "*.xls")

Do While NombreArchivo <> ""

n = n + 1

'Construimos la fórmula para para traer el dato

'Se extrae el dato, estoy suponiendo que en cada uno de los 4000 libros tienes una hoja llamada ANIMADOR defuult [en mayúsculas] y ahi estan los datos _

si no tienes la hoja nombrada de esa forma, por favor cambia el nombre en el inputbox inicial

Cells(n, "A") = ExecuteExcel4Macro("'" & ruta_directorio & "[" & NombreArchivo & "]" & CStr(NombreHoja) & "'!r2c1") 'estilo r1c1 es decir row1 col1 [Nombre de archivo]

Cells(n, "B") = ExecuteExcel4Macro("'" & ruta_directorio & "[" & NombreArchivo & "]" & CStr(NombreHoja) & "'!r2c9") 'estilo r1c1 es decir row1 col1 [Nombre de UDS]

NombreArchivo = Dir ' Obtiene siguiente entrada.

Application.StatusBar = " Recorriendo archivos, hasta el momento se han recorrido " & n - 1 & " archivo(s)"

Loop

MsgBox "Se extrajeron los datos de " & n - 1 & " archivo(s)", vbInformation

Application.StatusBar = False

End Sub

Function ObtieneRutaCarpeta()

Dim FiD As FileDialog, ItemSelect As Variant

'dialogo para seleccionar una carpeta

Set FiD = Application.FileDialog(msoFileDialogFolderPicker)

With FiD

.Title = "Selecciona la Carpeta que deseas Recorrer para extraer el dato de la celdas A2 y I2"

.ButtonName = "Seleccionar"

.AllowMultiSelect = False

If .Show = -1 Then

For Each ItemSelect In .SelectedItems

'se determina el item seleccionado [Ruta Carpeta]

ObtieneRutaCarpeta = ItemSelect

Next ItemSelect

Else

ObtieneRutaCarpeta = False

End If

End With

Set FiD = Nothing

End Function

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

Saludos

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.