BuildPath Método

Se me olvidó poner el código para salvar los libros. Después del Stop tienes que añadir:

Else
wkb.SaveAs Filename:=wkb.Worksheets("Hoja1").Range("Q11")
wkb.Close

Un saludo.


Fernando Arroyo
MS MVP - Excel

Gracias Fernando!

Aquí te envío la solución que me enviaste con las
adaptaciones que le hice para que me funcionara.

En el libro "Configuración", hoja "Derechos", celda "D12"
se construye la ruta "C:\Auditor\SG\2002\" y en las
celdas "Q11:Q21" se agregan 11 nombres de archivos, en
rutas parecidas a ésta "C:\Auditor\SG\2002\Anexos.xls"

Estas rutas se forman conbinando datos de los libros y
deben salvarse estando abiertos porque están vinculados
unos con otros y de otra manera se desvinculan.

Así como sigue, me funcionó:
Function CrearDirectorio(strRuta As String) As Boolean
'Sintaxis: CrearDirectorio("Unidad:\Directorio1
\Directorio2\...\Directorio n")

Dim fsoF As Object
Set fsoF = CreateObject("Scripting.FileSystemObject")
Dim mtr() As String, n As Integer, strCreandoRuta As
String

mtr = Split(strRuta, "\")

If UBound(mtr) - LBound(mtr) = 0 Then Exit
Function 'La ruta que se quiere crear no es correcta
If Dir(mtr(LBound(mtr))) = "" Then Exit Function 'La
unidad no existe

strCreandoRuta = mtr(LBound(mtr()))

For n = LBound(mtr) + 1 To UBound(mtr)
strCreandoRuta = strCreandoRuta &
Application.PathSeparator & mtr(n)
If Not fsoF.FolderExists(strCreandoRuta) Then
fsoF.CreateFolder strCreandoRuta
Next n

Set fsoF = Nothing

CrearDirectorio = True 'La función devuelve True para
indicar que la ruta se pudo crear
End Function

Sub Guardar_Como()
'
' Guardar_Como Macro
' Esta Macro crea una Nueva Ruta y Renombra los Libros en
ella.
'
' Keyboard Shortcut: Ctrl+c
'
CrearDirectorio (Left(Workbooks("Configuracion").Sheets
("Derechos").Range("D12").Value, InStrRev(Workbooks
("Configuracion").Sheets("Derechos").Range
("D12").Value, "\") - 1))

Windows("Anexos.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q11").Value
Windows("Aportes.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q12").Value
Windows("Configuracion.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q13").Value
Windows("Consultas.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q14").Value
Windows("Convenios.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q15").Value
Windows("Estados.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q16").Value
Windows("Formularios.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q17").Value
Windows("OtrasRet.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q18").Value
Windows("Presentacion.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q19").Value
Windows("RetCompl.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q20").Value
Windows("Retenciones.xls").Activate
ActiveWorkbook.SaveAs Workbooks("Configuracion").Sheets
("Derechos").Range("Q21").Value

End Sub