VBA Código para mover hojas cuyos nombres están en un rango a otro libro

Estoy empezando con esto de las macros y la programación VBA por temas de trabajo y necesito hacer lo siguiente:

En la hoja "Selección" tengo un rango ("K7:K19") que contiene un listado de nombres (por ejemplo, Elena, María, Miriam,...)

Mi Libro tiene varias hojas (unas 15), con diferentes nombres (Pedro, Hugo, Rubén, Elena, Miriam, Javier,...)

Necesito mover a otro libro las hojas cuyo nombre aparezca en el rango ("K7:K19")

Para probar, he intentado hacerlo primero para un único valor (p. Ej. Miriam) pero, me copia la pestaña que no quiero :(

Por ahora llevo esto hecho:

Dim origen As Workbook
Dim destino As Workbook
Public lista As Range
Sub guardarhoja()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Identificar los libros origen y destino y la lista con los nombres
Set origen = ActiveWorkbook
Set lista = Worksheets("SELECCIÓN").Range("K7:K19")
Workbooks.Add
Set destino = ActiveWorkbook
origen.Activate
'Cuando el nombre de unahoja es igual a un nombre de la lista --> mueve la hoja al libro destino
Dim s As Worksheet
For Each s In origen.Worksheets
    If s.Name = "MIRIAM" Then s.Select
    ActiveSheet.Move Before:=destino.Sheets(1)
    Next s
End Sub

1 Respuesta

Respuesta
1

[Hola

Manteniendo tu misma idea y respetando tu variables públicas, prueba así:

Dim origen As Workbook
Dim destino As Workbook
Public Lista As Range
Sub guardarhoja()
Dim Hoja As Worksheet
Dim Celda As Range, Lista As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set origen = Workbooks("Libro2")
Set Lista = Workbooks("Libro2").Worksheets("SELECCIÓN").Range("K9:K10")
Workbooks.Add
For Each Hoja In origen.Worksheets
    For Each Celda In Lista
        If LCase(Hoja.Name) = LCase(Celda.Value) Then
            Hoja.Move Before:=ActiveWorkbook.Sheets(1)
            Exit For
        End If
    Next
Next
End Sub

Donde puse "Libro2" tú reemplaza por el nombre correcto de tu libro.

Comentas

Abraham Valencia

Obviamente también reemplaza el rango de "K" por el tuyo en donde corresponde.

Abraham Valencia

Muchas gracias por tu rápida respuesta Abraham!!

Funciona perfecto!

Voy a continuar evolucionando el fichero así que seguro que volveré por aquí :)

Un saludo,

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas