ayuda macros

hola, !

tengo esta macro, y necesito hacer la misma pero que habla los archivos de una carpeta especifica
que no es la misma donde se encuentra el archivo. necesito saber que hay que cambiar.

- como quieres indicarle al codigo en cual carpeta ha de buscar los archivos (o cual es esa carpeta "especifica") ?
- confirmas que todos los libros (en esa carpeta) tienen una hoja llamada "avance" ?
- confirmas que de cada hoja (avance) en cada libro solo requieres copiar los valores de las celdas A1 y B8 ?
- cual podria ser la diferencia al calcular la "uf" en las columnas B y C (C para depositar datos en la columna D) ?
- si solo se trata de dos celdas, por que tu codigo originalmente "limpia" un rango de 6 columnas (B:G) ?

comentas (si hubiera) cualquier detalle adicional "en el tintero" ?
saludos,
hector.

__ el codigo expuesto __
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
ActiveWorkbook.Close (0)
Salto:
arch = Dir
Loop
MsgBox ("Importación Lista")
End Sub

- como quieres indicarle al codigo en cual carpeta ha de buscar los archivos (o cual es esa carpeta "especifica") ?
- confirmas que todos los libros (en esa carpeta) tienen una hoja llamada "avance" ?
- confirmas que de cada hoja (avance) en cada libro solo requieres copiar los valores de las celdas A1 y B8 ?
- cual podria ser la diferencia al calcular la "uf" en las columnas B y C (C para depositar datos en la columna D) ?
- si solo se trata de dos celdas, por que tu codigo originalmente "limpia" un rango de 6 columnas (B:G) ?

comentas (si hubiera) cualquier detalle adicional "en el tintero" ?
saludos,
hector.

__

- la carpeta 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)
-si, todos los archivos en esa carpeta tienen "avance"
-es que pense que si ponia el la macro mas corta ya que gran parte es
casi igual iba a ser mas amigable de ver.
-tienes razon ahi estaba mi error !!!!! gracias!!! no me habia dado
cuenta.

mira lo que necesito es copiar ciertas celdas de un monton de archivos
y pegarlas en otro.
la correlacion de celdas es

desde hacia
A1--> B
B4-->F
B5-->G
B6-->E
B7-->C
B8-->D

ojala me la puedas arreglar.

mil gracias.!!


aqui esta entera mi macro tal y como la tenia.


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