Ayuda Macro

[karlos]

hola a todos, les queria pedir ayuda con una macro.

tengo esta macro, no estoy muy seguro que este 100% buena y ademas
necesito hacer la misma pero que abra los
archivos de una carpeta especifica, que no es la misma donde se
encuentra el archivo.
necesito saber que hay que cambiar.

la carpeta donde se encuentra el archivo se llama terminados y la
direccion completa es : ( \
\RECEPCION\Documentos c\Balanced ScoreCard LW\Control de Proyectos
\proyectos\Terminados)
y el archivo donde esta la macro se llama proyectos ( uno mas arriba)

Sub gen_lista()

Range("B7:g134").Select
Selection.ClearContents

ChDir (ActiveWorkbook.Path)
ruta = ActiveWorkbook.Path
nonfic = ActiveWorkbook.Name
arch = Dir("*.xls")
fil = 1

Application.ScreenUpdating = False
Do Until arch = ""
If arch = nonfic Then GoTo Salto
Workbooks.Open Filename:=arch, UpdateLinks:=0

Windows(arch).Activate

Sheets("avance").Select
Range("A1").Copy
Windows(nonfic).Activate
uf = Range("b65536").End(xlUp).Row + 1
Range("b" & uf).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Windows(arch).Activate

Sheets("avance").Select
Range("b8").Copy
Windows(nonfic).Activate
uf = Range("c65536").End(xlUp).Row + 1
Range("d" & uf).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Windows(arch).Activate

Sheets("avance").Select
Range("b4").Copy
Windows(nonfic).Activate
uf = Range("e65536").End(xlUp).Row + 1
Range("f" & uf).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Windows(arch).Activate

Sheets("avance").Select
Range("b5").Copy
Windows(nonfic).Activate
uf = Range("c65536").End(xlUp).Row + 1
Range("g" & uf).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Windows(arch).Activate

Sheets("avance").Select
Range("b6").Copy
Windows(nonfic).Activate
uf = Range("c65536").End(xlUp).Row + 1
Range("e" & uf).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Windows(arch).Activate

Sheets("avance").Select
Range("b7").Copy
Windows(nonfic).Activate
uf = Range("c65536").End(xlUp).Row + 1
Range("c" & uf).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Windows(arch).Activate
ActiveWorkbook.Close (0)
Salto:
arch = Dir
Loop

MsgBox ("Importación Lista")

End Sub

muchas gracias

saludos

[Héctor Miguel]

hola, !

> ... esta macro... necesito hacer la misma pero que abra los archivos de una carpeta
> ... que no es la misma donde se encuentra el archivo. necesito saber que hay que cambiar.

> la carpeta donde se encuentra el archivo se llama terminados y la direccion completa es:
> (\\RECEPCION\Documentos c\Balanced ScoreCard LW\Control de Proyectos\proyectos\Terminados)

> y el archivo donde esta la macro se llama proyectos (uno mas arriba) (...)

prueba con algo +/- como lo siguiente:
- el primer procedimiento es la macro "en si"
- el segundo es una funcion (vba) que llama el anterior por cada celda con informacion)

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Sub Importa_datos()
Dim Celda, colDest, Ruta As String, Archivo As String, _
Hoja as String, nFila As Integer, n As Byte
Celda = Array("a1", "b7", "b8", "b6", "b4", "b5")
colDest = Array("b", "c", "d", "e", "f", "g")
Ruta = ThisWorkbook.Path & "\terminados"
Hoja = "avance"
Application.ScreenUpdating = False
Range("b7:g134").ClearContents
Archivo = Dir(Ruta & "\*.xls")
Do While Archivo <> ""
nFila = Range("b65536").End(xlUp).Row + 1
For n = Lbound(Celda) To Ubound(Celda)
Range(colDest(n) & nFila) = LeerArchivoCerrado(Ruta, Archivo, Hoja, Celda(n))
Next
Archivo = Dir()
Loop
End Sub

Function LeerArchivoCerrado( _
ByVal Ruta As String, _
Archivo As String, _
Hoja As String, _
Celda As String)
If Right(Ruta, 1) <> "\" Then Ruta = Ruta & "\"
TomarDeArchivoCerrado = _
ExecuteExcel4Macro("'" & _
Ruta & "[" & Archivo & "]" & Hoja & "'!" & _
Range(Celda).Range("a1").Address(, , xlR1C1))
End Function

[karlos]

me sale error de compilacion:
el tipo de argumento de byref no coincide.

y se detiene en :

Range(colDest(n) & nFila) = LeerArchivoCerrado(Ruta, Archivo,
Hoja, Celda(n))

donde dice celda(n)

que puede ser ????

gracias

carlos

[H�ctor Miguel]

hola, carlos !

cierto, es por la variable Celda (de tipo Variant) que la funcion requiere convertirla al tipo String
(y hay un error en la llamada al nombre de la funcion dentro de la misma funcion... sorry) :-((

1) cambia esa instruccion (parte final) para que se lea asi:

Range(colDest(n) & nFila) = LeerArchivoCerrado(Ruta, Archivo, Hoja, CStr(Celda(n)))

2) modifica la funcion para que quede asi:

Function LeerArchivoCerrado( _
ByVal Ruta As String, _
Archivo As String, _
Hoja As String, _
Celda As String)
If Right(Ruta, 1) <> "\" Then Ruta = Ruta & "\"

LeerArchivoCerrado = _

ExecuteExcel4Macro("'" & _
Ruta & "[" & Archivo & "]" & Hoja & "'!" & _
Range(Celda).Range("a1").Address(, , xlR1C1))
End Function

(por si las dudas) notaras que los archivos permanecen SIN abrirse (la funcion lee de ellos estando cerrados)

saludos,
hector.

[karlos]

me funciona perfectamente mil gracias, pero ahora necesito hacerle
unos cambios, en cuanto a la ruta de los archivos a buscar, lo intente
pero no me funciono.
mis preguntas son, que modificaciones hay que hacerle para que haga lo
mismo pero:
1) que busque en los archivos dentro de la misma carpeta (que el
archivo que esta ejecutando la macro)

2) que busque en otra ruta. mas especifica, es decir:
C:\Users\KaRLoS\Desktop\control de proyectos

muchas gracias

saludos

adjunto la macro inicial.

Sub Importa_datos()
Dim Celda, colDest, Ruta As String, Archivo As String, _
Hoja As String, nFila As Integer, n As Byte

Celda = Array("a1", "b7", "b8", "b6", "b4", "b5")
colDest = Array("b", "c", "d", "e", "f", "g")
Ruta = ThisWorkbook.Path & "\terminados"
Hoja = "avance"
Application.ScreenUpdating = False
Range("b7:g134").ClearContents
Archivo = Dir(Ruta & "\*.xls")
Do While Archivo <> ""
nFila = Range("b65536").End(xlUp).Row + 1

For n = LBound(Celda) To UBound(Celda)

Range(colDest(n) & nFila) = LeerArchivoCerrado(Ruta, Archivo,
Hoja, CStr(Celda(n)))

Next
Archivo = Dir()
Loop
End Sub

Function LeerArchivoCerrado( _

[H�ctor Miguel]

hola, !

> ... que modificaciones hay que hacerle para que haga lo mismo pero:

> 1) que busque en los archivos dentro de la misma carpeta (que el archivo que esta ejecutando la macro)
> 2) que busque en otra ruta. mas especifica, es decir: C:\Users\KaRLoS\Desktop\control de proyectos

solo cambia la asignacion a la variable Ruta (de tipo string) para que sea la que necesitas

en el ejemplo (y de acuerdo con tu consulta original) se asigna una subcarpeta (terminados) bajo la ruta del libro con la macro

Ruta = ThisWorkbook.Path & "\terminados"

si necesitas solo la ruta del libro con la macro, cambia la instruccion a:
Ruta = ThisWorkbook.Path

si necesitas una ruta "especifica"... especificala al asigar el valor de la variable (p.e.)
Ruta = "c:\users\karlos\desktop\control de proyectos"

saludos,
hector.

[karlos]

me funciono perfecto cuando especifico ruta, pero me falla cuando el
archivo esta en la misma carpeta que los otros doc.
Ruta = ThisWorkbook.Path

me sale el siguiente error "1004" y dice:
una formula de esta hoja de calculo contiene una o mas referencias no
validas.
compruebe que las formulas contienen una ruta de acceso, un libro, un
nombre del rango y una referencia de caldas validas
y se detiene en la funcion específicamente en " Range(Celda).Range
("a1").Address(, , xlR1C1))"

cual podria ser la variacion a la formula para que se pueda hacer
esto ??

muchas gracias y disculpa las molestias
saludos

[H�ctor Miguel]

hola, !

> me funciono perfecto cuando especifico ruta, pero me falla cuando el archivo esta en la misma carpeta que los otros doc.
> Ruta = ThisWorkbook.Path
> me sale el siguiente error "1004" y dice: una formula de esta hoja de calculo contiene una o mas referencias no validas.
> compruebe que las formulas contienen una ruta de acceso, un libro, un nombre del rango y una referencia de caldas validas

> y se detiene en la funcion espec�ficamente en " Range(Celda).Range("a1").Address(, , xlR1C1))"

> cual podria ser la variacion a la formula para que se pueda hacer esto ??

(probablemente) se debe a que estas consultando TODOS los *.xls de la carpeta incuyendo al libro con la macro
esto podria ocasionar una infraccion de uso compartido :-(
prueba cambiando en el bucle del procedimiento +/- a lo siguiente:

Do While Archivo <> ""
If Dir(Archivo) = ThisWorkbook.Name Then GoTo ElQueSigue

nFila = Range("b65536").End(xlUp).Row + 1
For n = LBound(Celda) To UBound(Celda)
Range(colDest(n) & nFila) = LeerArchivoCerrado(Ruta, Archivo, Hoja, CStr(Celda(n)))
Next

ElQueSigue:
Archivo = Dir()
Loop

saludos,
hector.