Macro en Excel para Copiar dos pestañas en un libro nueo y adjuntar por email en excel
Quisiera saber como poder copiar dos hojas de un libro y pegarlas en un libro nuevo sin formulación y a su vez adjuntarlo para enviar por email.
1 Respuesta
Respuesta de Dante Amor
1
H o l a :
Puedes decirme lo siguiente:
- Cómo se llaman las hojas
- Cómo se va a llamar el nuevo libro
- Sin formulación, te refieres a que se pongan solamente valores
- El correo se va a enviar por outlook
- Cuál es el destinatario
- Cuál es el mensaje del correo
- Cuál es el cuerpo del correo
E spero tus respuestas en ese orden.
Sal u dos
Buenos días,
1. Las hojas son country y items.
2. Debe tomar el nombre de la celda A1
3. Solo formatos y valores.
4. El correo se enviará por Outlook
5. El destinatario lo debe introducir el usuario.
6. El asunto debe ser el nombre del libro
7. El cuerpo del correo lo debe de introducir el.usuario.
Muchas gracias y saludis
Te anexo la macro
Sub EnviarHojas()
'Por.Dante Amor
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.SheetsInNewWorkbook = 2
'
h1 = "country"
h2 = "items"
'
Set l1 = ThisWorkbook
'valida hojas
For Each h In Sheets
If LCase(h.Name) = h1 Then
ban1 = True
End If
If LCase(h.Name) = h2 Then
ban2 = True
End If
Next
If ban1 = False Then
MsgBox "Falta la hoja " & h1, vbExclamation
Exit Sub
End If
If ban2 = False Then
MsgBox "Falta la hoja " & h2, vbExclamation
Exit Sub
End If
'valida nombre de libro
nombre = l1.Sheets(h1).Range("A1")
If nombre = "" Then
MsgBox "Falta el nombre del libro ", vbExclamation
Exit Sub
End If
correo = InputBox("Ingresa el correo")
If correo = "" Or correo = False Then
MsgBox "Falta el nombre del correo", vbExclamation
Exit Sub
End If
cuerpo = InputBox("Ingresa el texto del cuerpo del correo")
If cuerpo = "" Or cuerpo = False Then
MsgBox "Falta el cuerpo del correo", vbExclamation
Exit Sub
End If
'
Set l2 = Workbooks.Add
l1.Sheets(h1).Cells.Copy
l2.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
l2.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteFormats
l2.Sheets(1).Name = h1
l1.Sheets(h2).Cells.Copy
l2.Sheets(2).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
l2.Sheets(2).Range("A1").PasteSpecial Paste:=xlPasteFormats
l2.Sheets(2).Name = h2
'
ruta = l1.Path & "\"
ActiveWorkbook.SaveAs Filename:=ruta & nombre & ".xlsx"
ActiveWorkbook.Close False
'
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = correo
dam.Subject = nombre
dam.Body = cuerpo
dam.Attachments.Add ruta & nombre & ".xlsx"
'dam.Display
dam.Send
MsgBox "Correo enviado", vbInformation
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
