Forums Últimos mensajes - Powered by IBM
 
Tags Palabras claves

Ayuda Macro

06/04/2009 - 19:32 por karlos | Informe spam
Ayuda Hacer una pregunta
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
email Siga el debateRespuesta 7 respuestasRespuesta Tengo una respuesta
DRAGON AGE™: INQUISITION – Matadragones
 

Leer las respuestas

#1 Héctor Miguel
07/04/2009 - 05:14 | Informe spam
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

Preguntas similares

 

Busqueda sugerida :