Estimado Hector
Estaba revisando estas líneas del 19 feb 2006 y me parece muy
interesante la forma simple y didáctica de realizar el copiado del
contenido de los archivos y consolidarlos en un solo archivo ya que
después se pueden procesar indistintamente, yo lo estoy usando pero me
a surgido un pequeño inconveniente, cada vez que adiciono un archivo
mas en la carpeta " Buscar Donde" en mi caso "ReportesUNI" y ejecuto
el programa se vuelven a copiar nuevamente todos los archivos y ya no
es amigable para analizar los contenidos, espero se entienda mi
inquietud, desde ya gracias por tu apoyo.
Saludos
Juan Carlos
On 19 feb 2006, 03:35, "Héctor Miguel" <NOhemiordiS...@PLShotmail.com>
wrote:
hola, Cesar !
> ... 30 funcionarios que quincenalmente me envian un reporte en Excel de las horas que estuvieron en determinado cliente, ej:
> Cliente1 8Hrs
> Cliente2 12Hrs
> .
> Cliente n nHrs
> ... me toca tomar archivo por archivocopiaresosdatosy agregarlos a una nueva hoja para tener un resumen de todos en un solo lugar
> habra forma de automatizar este proceso?
algunos 'detalles' que no has comentado... podrian 'hacer la diferecia' :)) [sin embargo]...
si 'pones' esosarchivosen unacarpeta'especifica'... podrias usar un 'FileSearch' para abrir cada libro y extraer 'susdatos' ;)
-> prueba/adapta/modifica/comenta/... algo +/- como el ejemplo al final del presente ;)
si cualquier duda [o informacion adicional]... comentas ?
saludo,
hector.
en un modulo de codigo 'normal' -> en el libro 'resumen' ==> Sub Abre_Copia_Cierra()
Application.ScreenUpdating = False
Dim BuscarDonde As String, Sig As Integer
' en la siguiente linea ESPECIFICA el directorio donde quieres 'buscarlos' '
BuscarDonde = "c:uta y\sub-carpetadondeestan\losarchivos\" ' NO olvides al final el ->\<- '
With Application.FileSearch
.NewSearch
.LookIn = BuscarDonde
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For Sig = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(Sig)
Worksheets(1).Activate
Range(Range("a2"), Range("b65536").End(xlUp)).Copy _
ThisWorkbook.Worksheets(1).Range("a65536").End(xlUp).Offset(1)
ActiveWorkbook.Close False
Next
Else: MsgBox "No existen documentos en " & BuscarDonde
End If
End With
End Sub
Leer las respuestas