ayuda con macro excel y VBA

* 29 mar 2017 09:58

Enlace permanente

Buenos días, necesito hacer una macro, y estoy en un punto muerto, ya que no se para donde tirar. Primero informo, que hace como 10 años que no toco nada de macros, por lo que mi conocimiento se acerca peligrosamente a cero.

Primero os dejo una imagen del excel para visualizarlo:



La macro consiste en que pulsando un botón, en la hoja llamada "ORIGEN" busca la primera fila que en la columna 1 tenga el valor "OK", la corte y la pegue en la primera fila libre de la hoja llamada "destino".
El código que he usado es el siguiente(si, ya se que es un poco chapucero, pero funcionar, funciona):

Private Sub CommandButton1_Click()

Cells.Find(What:="OK", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate


ActiveCell.EntireRow.Cut
Sheets("Destino").Select
Sheets("Destino").Activate

Worksheets("Destino").Activate

ActiveSheet.Range("A1").Select

Selection.End(xlDown).Select

ActiveCell.Offset(1, 0).Select

ActiveSheet.Paste

Sheets("Origen").Select
Sheets("Origen").Activate

Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlUp

ActiveSheet.Range("A1").Select

End Sub

Ahora, quiero que cuando encuentre esa fila cuya columna 1 contenga "OK", mande un email usando los datos de las celdas para el destinatario, asunto, cuerpo del texto etc.

El código(sacado de una web) es el siguiente:

Sub BOTONENVIAREMAIL()

Dim i, j As Integer
Dim pagina1 As Worksheet
Set pagina1 = ActiveWorkbook.Worksheets("Origen")
Dim OutApp As Object
Dim Correo As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Comprobar si Outlook esta abierto y en caso de no estarlo abrirlo
On Error Resume Next
Set OutApp = GetObject("", "Outlook.Application")
Err.Clear
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
OutApp.Visible = True
Set Correo = OutApp.CreateItem(0)
'Crear el correo y mostrarlo
With Correo
.To = pagina1.Range("C8").Value
.CC = pagina1.Range("C9").Value
.Subject = pagina1.Range("C10").Value
.HTMLBody = pagina1.Range("C11").Value
.Display
'para enviar el correo directamente sin mostrarlo, sustituir .Display por .Send'
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

Mi problema es que no se como fusionar los dos códigos, para que cuando encuentre la fila con el OK, mande un email usando los datos de esa fila, y la corte y pegue en la siguiente hoja.


Muchisimas gracias!

Un saludo.


[EDITO]: he subido el archivo con el que estoy haciendo las pruebas por si os es de ayuda.

prueba macro - copia.xlsm (20.89 KB)