Consulta sobre macro para copiar una hoja en otro libro
Te comento lo siguiente: necesito por favor una macro que me permita copiar un rango de mi hoja que se llama "recetas" el rango va desde la celda A1 hasta la celda E32, a otro libro que se llame recetas dentro de este libro se deben copiar las recetas.
Por ejemplo, voy a crear la receta "TACOS", este nombre se encuentra en la celda "b5", la copia de esta hoja debe crearse con el nombre de la celda b5, y debe alojarse en la Hoja1 del libro "recetas", si creo otra receta "enchiladas" este nombre también se encuentra en la celda b5 y esta, debe alojarse en la Hoja 2 del libro "recetas" y así sucesivamente... Espero contar con tu ayuda o te agradecería si tuvieras un correo para poderte escribir y explicar mejor.
1 Respuesta
Te adjunto 1ra macro para el punto 1... faltan detalles a resolver, por ejemplo qué hacer en caso de que ya exista hoja con ese nombre... te estoy consultando a tu correo.
Sub copiaReceta()
'x Elsamatilde
'confirmar la copia de la hoja activa
sino = MsgBox("¿Deseas copiar esta hoja en libro RECETAS?", vbQuestion + vbYesNo, "CONFIRMAR")
If sino <> vbYes Then Exit Sub
'asigna nbre al libro actual y guarda el nbre para la nueva hoja
lib1 = ActiveWorkbook.Name
nbrehoja = [B5]
'verifica si el libro ya se encuentra abierto sino lo abrirá desde la misma carpeta ----AJUSTAR
lib2 = "RECETAS.xlsx"
For Each wb In Workbooks
If wb.Name = lib2 Then esta = 1: Exit For
Next wb
If esta = 0 Then
Workbooks.Open ThisWorkbook.Path & "/" & lib2, UpdateLinks:=0
Else
Workbooks(lib2).Activate
End If
'agrega una hoja y coloca el nombre
Workbooks(lib2).Sheets.Add After:=ActiveSheet
On Error Resume Next
ActiveSheet.Name = nbrehoja
If Err.Number > 0 Then
MsgBox "Ya existe hoja con ese nombre, debes nombrarla manualmente."
nbrehoja = ActiveSheet.Name
On Error GoTo 0
End If
ActiveSheet.[A1].Select
'vuelve al libro original
Workbooks(lib1).Activate
[A1:E45].Copy
Workbooks(lib2).Activate
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
MsgBox "Fin de la copia"
End SubSdos.
Elsa
