Contar Hojas y mover a libro especifico Vba

Solicito en la medida de lo posible ayuda para una ampliación de macro que estoy realizando, tengo un libro con 40 hojas fijas y a partir de la 40 me va generando hojas con diferentes números, la macro consiste en contar hasta la hoja 40 y mover desde la hoja 40 hasta la ultima hoja generada a un libro con la colocación según se crea y su nombre respectivo. Adjunto macro que estoy realizando que solo me guarda la (Sheets("PRESUPUESTO FINAL"). Select):

Sub GRABAR_PRESUPUESTO_DE_CALCULO()
'
'
'
Dim ws As Worksheet
   'Set wss = Sheets("PRESUPUESTO FINAL") 'Hoja donde actua
    Set ws = Sheets("ALTA PRESUPUESTO1") 'Hoja donde actua
Sheets("GENERAR PRESUPUESTO").Select
Application.ScreenUpdating = False
On Error Resume Next
'ActiveSheet.Shapes("Picture 67").Visible = False 'abrir puerta
'ActiveSheet.Shapes("Picture 63").Visible = True 'abrir puerta
Sheets("PRESUPUESTO FINAL").Select
Dim Nom_Carpeta As String
Nom_Carpeta = ws.Range("K9").Value
If Nom_Carpeta = "" Then
MsgBox "Nombre Invalido." & Chr(13) & "Las carpetas no se crearán", vbOKOnly, "Error!!!"
Exit Sub
End If
Dim Nom_SubCarpeta As String
Nom_SubCarpeta = ws.Range("B1").Value
If Nom_SubCarpeta = "" Then
MsgBox "Nombre Invalido." & Chr(13) & "Las carpetas no se crearán", vbOKOnly, "Error!!!"
Exit Sub
End If
On Local Error Resume Next
MkDir "C:\Users\DAVID CA\Desktop\01-04-16\08-10-16\" & Nom_Carpeta
MkDir "C:\Users\DAVID CA\Desktop\01-04-16\08-10-16\" & Nom_Carpeta & "\" & Nom_SubCarpeta
 Dim RutaArchivo, NombreArchivo As String
Sheets("PRESUPUESTO FINAL").Select
Application.ScreenUpdating = False
EnableEvents = False
 RutaArchivo = "\\MOZART\Presupuestos\HISTORIAL PRESUPUESTARIO DAVID CALLEJA 2014\XSWM01311\ALTA DE PRESUPUESTOS\" & Nom_Carpeta & "\" & Nom_SubCarpeta & "\" & ws.Range("B2") & ".pdf"
 ActiveSheet.Copy
 Dim img As Shape
On Error Resume Next
For Each img In ActiveSheet.Shapes
     If img.Type = 1 Then img.Delete
Next
Dim bot As Button
On Error Resume Next
For Each bot In ActiveSheet.Buttons
     If bot.Type = 1 Then bot.Delete
Next
Rows("1:1").Select
    Selection.EntireRow.Hidden = True
 Application.DisplayAlerts = False
 ActiveSheet.SaveAs Filename:= _
 "C:\Users\DAVID CA\Desktop\01-04-16\08-10-16\" & Nom_Carpeta & "\" & Nom_SubCarpeta & "\" & ws.Range("B2") & ".xlsx"
 'For i = 1 To Sheets.Count
   'Sheets(i).Protect
 'Next i
'ActiveWorkbook.Save
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.Close False
 Sheets("GENERAR PRESUPUESTO").Select
Range("A1").Select
End Sub

1 Respuesta

Respuesta
2

H o l a : No entendí muy bien lo que necesitas. Podrías explicar qué requieres.

Buenos días,

En primer lugar gracias , necesito importar las hojas de un libro a otro desde la hoja 40 hasta la última con sus nombres de hoja como si lo hiciera manual pero con macros y en la dirección que tengo en la macro adjunta en la petición. 

Le voy explicar como tengo elaborado el libro para la macro que necesito, he creado un libro con el nombre DESIGN DVACHQ222.xlsm y fui creando hojas y borrando a su vez con lo que me quedan hojas con números asignados por office pero nombradas diferentes por mi, su posición de izquierdas a derecha ejemplo:

Hoja1 (Nombre asiginado por mi "CALCULO")

Hoja10(Nombre asignado por mi "GENERARPRESUPUESTO")

Hoja12(Nombre asignado por mi "LISTADO DE COMPRAS")

ETC... la posición de Izquierda a derecha ( la Hoja1 tendría su posición nº1, la Hoja 10 su posición seria nº2 y la Hoja12 tendría su posición 3, y así hasta hasta la posición nº 40, a partir de la posición 40 voy generando hojas que quiero mover a otro libro desde la 40 hasta la ultima creada en la dirección de la macro que adjunto.

Adjunto macro

Sub GRABAR_PRESUPUESTO_DE_CALCULO()
'
' Macro94 Macro
' actualizada 15-05-16
Dim ws As Worksheet
   'Set wss = Sheets("PRESUPUESTO FINAL") 'Hoja donde actua
    Set ws = Sheets("ALTA PRESUPUESTO1") 'Hoja donde actua
Sheets("GENERAR PRESUPUESTO").Select
Application.ScreenUpdating = False
On Error Resume Next
'ActiveSheet.Shapes("Picture 67").Visible = False 'abrir puerta
'ActiveSheet.Shapes("Picture 63").Visible = True 'abrir puerta
Sheets("PRESUPUESTO FINAL").Select
Dim Nom_Carpeta As String
Nom_Carpeta = ws.Range("K9").Value
If Nom_Carpeta = "" Then
MsgBox "Nombre Invalido." & Chr(13) & "Las carpetas no se crearán", vbOKOnly, "Error!!!"
Exit Sub
End If
Dim Nom_SubCarpeta As String
Nom_SubCarpeta = ws.Range("B1").Value
If Nom_SubCarpeta = "" Then
MsgBox "Nombre Invalido." & Chr(13) & "Las carpetas no se crearán", vbOKOnly, "Error!!!"
Exit Sub
End If
On Local Error Resume Next
MkDir "\\MOZART\Presupuestos\HISTORIAL PRESUPUESTARIO DAVID CALLEJA 2014\XSWM01311\ALTA DE PRESUPUESTOS\" & Nom_Carpeta
MkDir "\\MOZART\Presupuestos\HISTORIAL PRESUPUESTARIO DAVID CALLEJA 2014\XSWM01311\ALTA DE PRESUPUESTOS\" & Nom_Carpeta & "\" & Nom_SubCarpeta
 Dim RutaArchivo, NombreArchivo As String
Sheets("PRESUPUESTO FINAL").Select
Application.ScreenUpdating = False
EnableEvents = False
 RutaArchivo = "\\MOZART\Presupuestos\HISTORIAL PRESUPUESTARIO DAVID CALLEJA 2014\XSWM01311\ALTA DE PRESUPUESTOS\" & Nom_Carpeta & "\" & Nom_SubCarpeta & "\" & ws.Range("B2") & ".pdf"
 ActiveSheet.Copy
 Application.DisplayAlerts = False
 ActiveSheet.SaveAs Filename:= _
 "\\MOZART\Presupuestos\HISTORIAL PRESUPUESTARIO DAVID CALLEJA 2014\XSWM01311\ALTA DE PRESUPUESTOS\" & Nom_Carpeta & "\" & Nom_SubCarpeta & "\" & ws.Range("B2") & ".xlsx"
 'For i = 1 To Sheets.Count
   'Sheets(i).Protect
 'Next i
'ActiveWorkbook.Save
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.Close False
 Sheets("GENERAR PRESUPUESTO").Select
Range("A1").Select
End Sub

Un Cordial Saludo

David.C

Lo que no entiendo es la macro.

Podrías poner los datos, es decir, selecciono las hojas de la 40 en adelante.

¿Quieres copiarlas a dónde? ¿A un archivo nuevo de excel o a un pdf?

¿En cuál ruta quieres guardar el archivo?

Ayúdame solamente con los datos, no me pongas toda la macro.

Buenas noches,

Dirección donde se guarda el libro nuevo excel \\MOZART\Presupuestos\HISTORIAL PRESUPUESTARIO DAVID CALLEJA 2014\XSWM01311\ALTA DE PRESUPUESTOS\" & Nom_Carpeta & "\" & Nom_SubCarpeta & "\" & ws.Range("B2") & ".xlsx"

******************************************************************

Crear Carpeta  y subcarpeta con nombre según celdas en la hoja con nombre "ALTA PRESUPUESTO1"

Set ws = Sheets("ALTA PRESUPUESTO1") 'Hoja donde actua

Nom_Carpeta = ws.Range("K9").Value

Nom_SubCarpeta = ws.Range("B1").Value

****************************************************************

El nombre del libro nuevo es según celda ws.Range("B2") en la hoja con nombre "ALTA PRESUPUESTO1"

y en el libro nuevo, muevo o copio las hojas de la 40 hasta la ultima creada del libro con nombre  DESIGN DVACHQ222.xlsm.

Un Cordial Saludo

David.C

Te anexo la macro.

Sub CopiarHojas()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("ALTA PRESUPUESTO1")
    '
    car1 = h1.Range("K9").Value
    car2 = h1.Range("B1").Value
    nomb = h1.Range("B2").Value
    ruta = "\MOZART\Presupuestos\HISTORIAL PRESUPUESTARIO DAVID CALLEJA 2014\XSWM01311\ALTA DE PRESUPUESTOS\"
    cad = ""
    numhojas = 40
    '
    If Dir(ruta, vbDirectory) = "" Then cad = "La ruta destino no existe. " & Chr(13)
    If car1 = "" Then cad = cad & "Nombre Carpeta Inválido." & Chr(13)
    If car2 = "" Then cad = cad & "Nombre SubCarpeta Inválido." & Chr(13)
    If nomb = "" Then cad = cad & "Nombre Archivo Inválido." & Chr(13)
    If Sheets.Count < numhojas Then cad = cad & "No hay hojas para copiar." & Chr(13)
    If cad <> "" Then
        MsgBox cad & "El archivo no se creará", vbCritical, "Error!!!"
        Exit Sub
    End If
    '
    If Dir(ruta & car1, vbDirectory) = "" Then
        MkDir ruta & car1
    End If
    If Dir(ruta & car1 & "\" & car2, vbDirectory) = "" Then
        MkDir ruta & car1 & "\" & car2
    End If
    '
    Dim hojas()
    n = 0
    For h = numhojas To Sheets.Count
        ReDim Preserve hojas(n)
        hojas(n) = Sheets(h).Name
        n = n + 1
    Next
    Sheets(hojas).Move
    ActiveWorkbook.SaveAs ruta & car1 & "\" & car2 & "\" & nomb & ".xlsx"
    ActiveWorkbook.Close
    '
    Application.ScreenUpdating = True
    MsgBox "Hojas copiadas", vbInformation
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

¡Gracias! Madre Mía eres Genio, muchas gracias y perdona las molestias ocasionadas, hasta la próxima.

Un Saludo

David.C

Una sola petición es que necesito la hoja 40 que además de moverla, también se me quede en el libro.

Al final de la respuesta te aparece un botón "Votada", presiona el botón; te aparecen 2 opciones "Excelente" y "Votar", puedes cambiar la valoración.

¡Gracias! 

Una sola petición Sr. Dante Amor, es que necesito la hoja 40 que además de moverla, también se me quede en el libro.

Si no valoras mis respuestas ya no te podré ayudar.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Crear carpeta y subcarpeta

Necesito crear automáticamente una carpeta con el nombre de una celda ( A1 )y subcarpeta según nombre en celda ( B12 ) y si estas existen siga la siguiente instrucción de la macro
2 respuestas

Crear carpetas y subcarpetas con macro

Recientemente el amigo Víctor Perdono me ayudo muchísimo con una macro, para conseguir redondear la macro necesito crear dos subcarpetas, una dentro de la otra. La 1ª carpeta es la del año actual, esta se toma de la celda M119 La 2ª carpeta es la del...
1 respuesta

Macro para acceso a determinadas hojas

Tengo unlibro en el cual se controla adecuadamente el acceso al mismo dependendo si el usuario esta inscrito en el mismo y además si esta habilitado. Ademas queda el registro histórico de los ingresos con fecha y hora, pero necesito encontrar la...
1 respuesta

Verificar si una macro ha cumplido su tarea

Tengo una macro que elimina el numero de documento que se indica en un imputbox, el numero del documento se almacena normalmente en varias hojas en la columna Z, pero yo le puedo escribir un numero que en realidad no se ha generado, y al final de la...
1 respuesta

Condicionar campos de un formulario

Para Dante Amor Continuando con la BBDD de la anterior pregunta y muy agradecido, ahora me gustaría condicionar algunos campos, como por ejemplo: 1. El campo ALTA, si es un cliente nuevo debe de poner la fecha actual. 2. Cualquier campo puede quedar...
1 respuesta

Habilitar macros

Tengo una hoja con una macro y quiero que al abrir el libro, cuando ponga el mensaje de si quieres habilitar las macros, no puedas pinchar en el botón de no o en todo caso que cuando pulses que no, se cierre el libro. ¿Es posible?
1 respuesta

Cómo recorrer sólo hojas visibles

Cómo podemos recorrer las hojas visibles de un libro Excel. La idea es poner un botón en cada hoja esté o no visible, y en el caso de que esté visible que al pulsar pase a la siguiente hoja visible hacia la derecha.
1 respuesta

Macro Para Ocultar Hojas excel y abrirlas con comboBox

Dante Ante todo u gran saludo a tu persona y por la gran ayuda que nos brindas en el foro, hiendo con mi pregunta. Tengo 30 hojas excel activas en las que ingreso datos, lo que necesito con este tema es que se pueda ocultar las hojas y solo me...
1 respuesta

Bloqueo para que no se vean hojas en excel

Tengo un archivo de Excel en el cual tengo 3 hojas y solo quiero que se vea la primera, un amigo me enseñó una secuencia en visual basic pero me marga que es incorrecta, ¿Me podrían ayudar por favor? Anexo secuencia Private Sub Workbook_Open()...
1 respuesta

Copiar datos de otra hoja excel

Primeramente agradecerles por sus apoyos a los novatos como nosotros: Quiero crear dos macros con las siguientes indicaciones: Macro1. Que me permita crear una nueva, ponerle un nombre (textbox1) y cuando le doy al botón de crear, me cree la nueva...
1 respuesta