Como guardar una hoja en un libro que ya extiste

[MarianoCruz]

Hola buneos dias.

 

Tengo un archivo que uso como plantilla está dentro de un libro 1 que he llamado (LibroOrigen). en ella esta una hoja llamada "Lista"

y una vez que lleno esta hoja lo copio en otro libro 2 (libro destino) ahí voy acumulándolos y cambio el nombre de estos.

Con una macro he podido enviar la hoja "Lista" de libro origen a libro destino, pero este me lo guarda con el nombre de "lista".

Me gustaría poder guardarlo en libro2, con el nombre puesto en una celda (A2) de la hoja lista Libro1. y así el acumulado ya tendrá nombre diferentes.

 

Muchas gracias

Mario

 

 

Libro Origen.xlsm

[JSDJSD]

Prueba y comenta 

Sub copiar_hojamc()
    Dim actual As Workbook
    Dim LibroDestino As Workbook
    Dim nuevaHoja As Worksheet
    Dim nombre As String
    Dim ruta As String

    Set actual = ThisWorkbook
    nombre = actual.Sheets("Lista").Range("A2").Value
    ruta = actual.Path

    On Error Resume Next
    Set LibroDestino = Workbooks.Open(ruta & "\" & "LibroDestino.xlsx")
    On Error GoTo 0

    If LibroDestino Is Nothing Then
        Set LibroDestino = Workbooks.Add
        LibroDestino.SaveAs ruta & "\" & "LibroDestino.xlsx"
    End If

    Dim hojaExistente As Boolean
    hojaExistente = False
    For Each hoja In LibroDestino.Sheets
        If hoja.Name = nombre Then
            hojaExistente = True
            Exit For
        End If
    Next hoja

    If hojaExistente Then
        nombre = InputBox("La hoja con el nombre '" & nombre & "' ya existe en el LibroDestino. Por favor, introduce un nuevo nombre:", "Nombre duplicado")
    End If

    Set nuevaHoja = LibroDestino.Sheets.Add(After:=LibroDestino.Sheets(LibroDestino.Sheets.Count))
    actual.Sheets("Lista").UsedRange.Copy
    nuevaHoja.Paste
    nuevaHoja.Name = nombre
    Application.CutCopyMode = False
    LibroDestino.Save
    LibroDestino.Close False
    actual.Activate

    MsgBox "El contenido de la hoja Lista se ha copiado al LibroDestino con el nombre " & nombre
End Sub