Copiar formato y valores en libro nuevo

[lil1234]

Hola Buen Día

Me gustaría si alguien me puede ayudar con este tema, cada vez que voy avanzando en mi base de datos me encuentro con otro inconveniente. Lo que me resulta muy interezante por que asi voy aprendiendo cada vez mas

Ahora si voy al punto

Necesito copiar información de unas hojas determinadas en un libro nuevo. Tengo que copiar tanto formatos como valores, Sin Formulas( Conservando los valores), ahí radica mi problema. Yo había utilizado la función Worksheets("Hoja1").Copy y si realmente me crea una copia en otro libro, pero conserva los links de donde obtiene la información y cuando necesito enviársela a alguien mas le sale error de referencia. claro por que los vínculos no se actualizan, ya que no poseen el archivo base.

He buscado en el foro y la solución a mi problema en parte la encontré en una respuesta dada anteriormente en este link

https://www.ayudaexcel.com/foro/macros-programacion-vba-10/solucionado-copiar-hoja-pero-solo-valores-formatos-14179/[/HTML]

Adjunto documento encontrado, pero al adaptarlo al archivo que estoy utilizando se queda pensando eternamente, esto se debe a que poseo muchas celdas que deben ser analizadas y casi todas están formuladas, el codigo utiliza un for para evaluar la sentencia, quitar la formula y poner solo el valor. Pero al estar en un for creo que es lo que hace que no lo pueda utilizar en mi archivo se demora mucho tiempo, tanto que se me bloquea el computador y me toca detener el proceso a la fuerza y cuando reviso solo ha cambiado unas pocas celdas

Este es El código. Esta muy bien estructurado gracias a un colaborador del foro "Macro Antonio"

[CODE]Sub Copiar_hojas_Nuevolibro()Dim fechahora As Variant
Application.DisplayAlerts = False
Application.ScreenUpdating = False


fechahora = Format(Now, "dd-mm-yyyy")
ThisWorkbook.Sheets(Array("CAMION", "TRACTOR", "AUTO", "BICICLETA")).Copy
'ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Inventario " & fechahora & ".xlsx"
ProcesoEliminarFormulas False 'Para respetar valores calculados
'ProcesoEliminarFormulas True 'Para Borrar valores calculados
ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox ("Archivo : Inventario " & fechahora & ".xlsx creado satisfactoriamente")


End Sub


Private Sub ProcesoEliminarFormulas(BorrarValores As Boolean)
Application.ScreenUpdating = False
For Each Hoja In ActiveWorkbook.Sheets

'DESPROTEGER HOJAS
If Hoja.Name = "CAMION" Then Hoja.Unprotect Password:="CAMION"
If Hoja.Name = "TRACTOR" Then Hoja.Unprotect Password:="TRACTOR"
If Hoja.Name = "AUTO" Then Hoja.Unprotect Password:="AUTO"
If Hoja.Name = "BICICLETA" Then Hoja.Unprotect Password:="BICICLETA"
'-------------------------------------------------------------------

For x = 1 To Hoja.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For y = 1 To Hoja.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Valor = Hoja.Cells(x, y).Value
If Hoja.Cells(x, y).HasFormula = True Then
Hoja.Cells(x, y) = ""
End If
If BorrarValores = False Then
Hoja.Cells(x, y) = Valor
End If
Next y
Next x

'PROTEGER HOJAS
If Hoja.Name = "CAMION" Then Hoja.Protect Password:="CAMION", DrawingObjects:=True, Contents:=True, Scenarios:=True
If Hoja.Name = "TRACTOR" Then Hoja.Protect Password:="TRACTOR", DrawingObjects:=True, Contents:=True, Scenarios:=True
If Hoja.Name = "AUTO" Then Hoja.Protect Password:="AUTO", DrawingObjects:=True, Contents:=True, Scenarios:=True
If Hoja.Name = "BICICLETA" Then Hoja.Protect Password:="BICICLETA", DrawingObjects:=True, Contents:=True, Scenarios:=True
'-------------------------------------------------------------------------------------------------------------


Next
End Sub


[/CODE]

Les agradezco si alguien conoce otra forma de hacer este procedimiento.

Muchas Gracias

PRINCIPAL II.zip