Macro para guardar varias hojas y en pdf

Esta rutina debería funcionar:

Sub Botón490_Haga_clic_en()
libro = ActiveWorkbook.Name
Sheets("Hoja1").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Facturas\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(libro).Activate
Sheets("Hoja2").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Hoja3").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.Close
End Sub

tengo asi la rutina y me da error donde lo tengo en negrita.

me copia la primera hoja en un archivo nuevo pero al saltar ese error ya se detiene la macro.

Sub Botón490_Haga_clic_en()
libro = ActiveWorkbook.Name
Sheets("Confirmación reserva").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Facturas\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(libro).Activate
Sheets("Ficha policía").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Albarán").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Factura").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.Close
End Sub

Ok, mi error con la modifiicación que hice no me di cuenta.

Sub Botón490_Haga_clic_en()
libro = ActiveWorkbook.Name
Sheets("Confirmación reserva").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Facturas\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre2, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(libro).Activate
Sheets("Ficha policía").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Albarán").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Factura").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.Close
End Sub

eso ya me va bien pero ahora me da error en la primera linea q puse en negrita.

no se supone q tengo q poner el nombre del archivo en la linea esa?

en las otras tb lo tengo q poner no?

perdona pero soy un novato en esto de las macros xD.

Sub Botón490_Haga_clic_en()
libro = ActiveWorkbook.Name
Sheets("Confirmación reserva").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Facturas\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre2, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(reservas1.xlsm).Activate
Sheets("Ficha policía").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Albarán").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Factura").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.Close
End Sub

Estaba

Windows(libro). Activate

Y lo cambiaste por:

Windows(reservas1.xlsm).Activate

En esta parte no debe ir el .xlsm, si vas a quemar el nombre del archivo, lo debes colocar sin la extensión.

Pregunto la variante libro que valor tiene en la rutina.

lo puse como estaba pero me da error en esa linea.

No entiendo lo q quieres decir con lo de la variante libro¿?

nombre1 se supone q es el nombre del documento nuevo q se hace no?

te vuelvo a pedir disculpas x mi ignorancia sobre las macros xD.

Sub Botón490_Haga_clic_en()
libro = ActiveWorkbook.Name
Sheets("Confirmación reserva").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Facturas\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre2, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(libro).Activate
Sheets("Ficha policía").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Albarán").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Factura").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.Close
End Sub

No te preocupes, que aquí estamos para aprender.

Creo que ya vi el error, y es que libro te saca el nombre del archivo junto con la extensión, te paso una rutina corregida para eliminar la corrección.

Sub Botón490_Haga_clic_en()
libro = ActiveWorkbook.Name
Longitud = InStrRev(libro, ".")
libro = Left(libro, Longitud - 1)
Sheets("Confirmación reserva").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Facturas\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre2, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(libro).Activate
Sheets("Ficha policía").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Albarán").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Factura").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(nombre1).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.Close
End Sub

Probé la macro para ver si funcionaba y si funciona, pero vi otro problema, todo se copia sobre la misma hoja, es decir, cada vez que vas a copiar una hoja nueva se sobre escribe sobre la primera que copiaste, hice unas correcciones y debería funcionar porque con tantos cambios esta vez la probé.

Sub Botón490_Haga_clic_en()
libro = ActiveWorkbook.Name
Longitud = InStrRev(libro, ".")
libro = Left(libro, Longitud - 1)
Sheets("Confirmación reserva").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "F:\FINANCIERO\CTB\TMP\ANEXOS BALANCE\2013\07 JULIO\INFORMES ADICIONALES\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre2, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(libro).Activate
Sheets("Ficha policía").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Albarán").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(3).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets.Add , After:=Sheets(3)
Windows(libro).Activate
Sheets("Factura").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(4).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook. Save
ActiveWindow. Close
End Sub

Pues no se xq pero a mi me da error en la linea en negrita.

Lo copie todo igual solo cambie el directorio del archivo.

Sub Botón490_Haga_clic_en()
libro = ActiveWorkbook.Name
Longitud = InStrRev(libro, ".")
libro = Left(libro, Longitud - 1)
Sheets("Confirmación reserva").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Facturas\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre2, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(libro).Activate
Sheets("Ficha policía").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Albarán").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(3).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets.Add , After:=Sheets(3)
Windows(libro).Activate
Sheets("Factura").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(4).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Sabe
ActiveWindow.Close
End Sub

¿Qué error te da?

Prueba colocando luego de Sub Botón490_Haga_clic_en()

Dim libro

Me da error en la linea q está en negrita. es igual que le ponga "Dim libro" me salta el error en esa linea de las dos formas.

Sub Botón490_Haga_clic_en()
Dim libro
libro = ActiveWorkbook.Name
Longitud = InStrRev(libro, ".")
libro = Left(libro, Longitud - 1)
Sheets("Confirmación reserva").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Jorge\Facturas\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre2, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(libro).Activate
Sheets("Ficha policía").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("Albarán").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(3).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets.Add , After:=Sheets(3)
Windows(libro).Activate
Sheets("Factura").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(4).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Sabe
ActiveWindow.Close
End Sub

DIme el número de error, y todo el texto del error que te bota.

se ha producido el error 9 en tiempo de ejecución:

subíndice fuera del intervalo

Es extraño, se supone que te puse esto para que no suceda ese problema:

libro = ActiveWorkbook.Name
Longitud = InStrRev(libro, ".")
libro = Left(libro, Longitud - 1)

borra las últimas dos lineas y dime que error te sale y en donde

Longitud = InStrRev(libro, ".")
libro = Left(libro, Longitud - 1)

me sigue dando el mismo error 9

Necesito saber que valor te presenta la variable libro, ¿sabes parar una macro en una línea especifica?

Le debes dar click derecho sobre Longitud = InStrRev(libro, ".")

Escoges alternar y punto de interrupción, luego dejas correr la macro y veras que la rutina se detiene en la parte donde pusiste el punto de interrupción, luego necesito que te posesiones con el cursor sobre la palabra libro y te debería aparecer un cuadro de dialo indicando el valor de la variable, me podrías decir que dice.

Otra opción es que corras esta rutina y me digas que dice A1

Sub valorlibro()
libro = ActiveWorkbook.Name

Range("A1").value = libro

End Sub

Pone esto:

Libro = "reservas1.xls"

La verdad no sé cual sea el problema, se me ocurre que podría ser la hoja, esta bien escrito el nombre de la hoja, todas las tildes, los espacios y todo de "Ficha policía"

le cambie los nombres a las hojas y lo puse así pero me sigue dando el mismo error:

Sub Botón490_Haga_clic_en()
Dim libro
libro = ActiveWorkbook.Name
Longitud = InStrRev(libro, ".")
libro = Left(libro, Longitud - 1)
Sheets("a").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Jorge\Facturas\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre2, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows(libro).Activate
Sheets("b").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(libro).Activate
Sheets("c").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(3).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets.Add , After:=Sheets(3)
Windows(libro).Activate
Sheets("d").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(4).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Sabe
ActiveWindow.Close
End Sub

La vedad yo pruebo la macro y en mi maquina corre sin ningún problema.

La verdad solo me queda un último recurso para saber que está pasando.

1) Vas a programador eliges macros y eliges grabar

2) Abre tu archivo del que generas la copia

3) Crea un nuevo libro

4) Con el mouse retrocedes y elige nuevamente el archivo original.

5) Ojo debe ser con el mouse no con ctrl + tab

6) Detienes la macro, y me pasas la rutina que se grabo, dejame ver como lo hace la grabación para tratar de entender porque te genera el error. Porque te cuento que el error lo que dice es que no tienes ningún libro abierto con el nombre reservas1.xls, lo cual es imposible ya que recién lo tenías abierto para generar la copia.

Creo q no estoy haciendo bien lo de grabar la macro que no me graba nada xd.

explicate un poco mejor de como se hace ya lo intente de varias formas y no me va XD.

1) Vas a la ficha de programador

2) Hay un botón que dice grabar macro

3) Al dar click en grabar macro te aparece una pantalla y le das aceptar

4) Vas al botón de office y le das unc click, te aparece un cuadro en el que debes elegir nuevo

5) Con el Mouse vas a la barra de archivos y eliges reservas1

6) Vas a la ficha de programador y detienes la macro,

7) Vas al vb y ves que grabo y me pasas la rutina

lo que grabo es esto aunque sigo sin tener claro si lo hago bien xD

Sub Macro1()
'
' Macro1 Macro
'
'
Workbooks.Add
Windows("reservas1.xls").Activate
End Sub

Pues la verdad sigo sin entender que problema genera hagamos algo.

En todo lo que dice

Windows(libro). Activate pon

Windows("reservas1.xls").Activate

Y me avisas.

poniéndolo asi me da error en la linea en negrita:

Sub Botón490_Haga_clic_en()
Dim libro
libro = ActiveWorkbook.Name
Longitud = InStrRev(libro, ".")
libro = Left(libro, Longitud - 1)
Sheets("a").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Jorge\Facturas\" & nombre1
ActiveWorkbook.SaveAs Filename:=nombre2, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows("reservas1.xls").Activate
Sheets("b").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows("reservas1.xls").Activate
Sheets("c").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(3).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets.Add , After:=Sheets(3)
Windows("reservas1.xls").Activate
Sheets("d").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(4).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Sabe
ActiveWindow.Close
End Sub

Luego de nombre2 = "C:\Users\Sucre\Desktop\Jorge\Facturas\" & nombre1 pon esta rutina

Longitud = InStrRev(nombre1, ".")
libro = Left(nombre1, Longitud - 1)

nombre1 = nombre1 & "xlsx"

me da error en la linea en negrita

Sub Botón490_Haga_clic_en()
Dim libro
libro = ActiveWorkbook.Name
Longitud = InStrRev(libro, ".")
libro = Left(libro, Longitud - 1)
Sheets("a").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
nombre1 = Application.InputBox("nombre del fichero")
nombre2 = "C:\Users\Sucre\Desktop\Jorge\Facturas\" & nombre1
Longitud = InStrRev(nombre1, ".")
libro = Left(nombre1, Longitud - 1)
nombre1 = nombre1 & "xlsx"
ActiveWorkbook.SaveAs Filename:=nombre2, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows("reservas1.xls").Activate
Sheets("b").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows("reservas1.xls").Activate
Sheets("c").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(3).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets.Add , After:=Sheets(3)
Windows("reservas1.xls").Activate
Sheets("d").Select
Cells.Select
Selection.Copy
Windows(nombre1).Activate
Sheets(4).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Sabe
ActiveWindow.Close
End Sub