Agregar 2 instrucciones a macro actual de registro
Me gustaría que me puedas ayudar agregando 2 instrucciones más a una macro actual que ya tengo.
La primera instrucción adicional que quiero que me ayudes a incluir en la actual macro es que si la celda C9 contiene palabras como: Consulta o Control o Revisión o Retoque o Inasistencia o Procedimiento entonces unicamente haga lo que actualmente hace la actual macro (así como esta)
Pero si NO contiene alguna de esas palabras entonces aparte de hacer lo que hace la actual macro, adicional a eso, haga ese mismo proceso de copiado pero en la hoja "PROCEDIMIENTOS" del actual libro.
No se si me hice entender bien osea es casi que registrar dos veces los mismos datos pero en hojas diferentes en donde en una de las hojas llamada "CARTERA" se copian todos, pero en la hoja llamada "PROCEDIMIENTOS" solo se copian los que cumplan la condición de NO CONTENER alguna de esas palabras.
La segunda instrucción que me gustaría que me ayudes es que antes de terminar la actual macro antes de hacer el proceso de borrado de las celdas en la hoja "VISITAS" me pregunte a través de un msgbox "Ud desea realizar un nuevo registro con los mismo datos actuales?" en caso de responder que SI entonces termina la macro y no borra los datos de las celdas de la hoja "VISITAS" en caso de contestar que NO entonces ahí si borra los datos y termine la macro.
La macro actual es la siguiente:
Sub REGISTROS() 'Act.Por.Dante Amor Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Set h1 = Sheets("VISITAS") Set h2 = Sheets("CARTERA") Set h4 = Sheets("CLIENTES") ' u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1 h1.Range("C5:C14").Copy: h2.Range("A" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=True h1.Range("F5:F14").Copy: h2.Range("K" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=True h1.Range("F2").Copy: h2.Range("U" & u).PasteSpecial Paste:=xlPasteValues, Transpose:=False h2.Range("V3:Y3").Copy h2.Range("V" & u) h2.Range("F" & u).TextToColumns Destination:=h2.Range("Z" & u), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 2), Array(1, 1), Array(4, 1)), TrailingMinusNumbers:=True h2.Range("AC3").Copy h2.Range("AC" & u) h2.Range("H" & u).TextToColumns Destination:=h2.Range("AD" & u), _ DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Space:=True, _ FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True h2.Range("AF" & u) = "=TEXT(RC[-31],""yyyy"")" h2.Range("AG" & u) = "=TEXT(RC[-32],""mmmm"")" h2.Range("AH" & u) = "=IF(RC[-4]="""","""",IF(RC[-4]=""plan"",""Particulares"",RC[-3]))" Set b = h4.Columns("C").Find(h1.[C7], lookat:=xlWhole) If Not b Is Nothing Then h2.Range("AW" & u) = h4.Cells(b.Row, "F") End If ' h1.Unprotect Password:="0976342842" H1. Range("F5:F7"). ClearContents H1. Range("F10:F12"). ClearContents H1. Range("F14"). ClearContents H1. Range("C6:C7"). ClearContents H1. Range("C9:C12"). ClearContents H1. Range("C14"). ClearContents h1.Range("F2") = h1.Range("F2") + 1 h1.Protect Password:="0976342842" Application.ScreenUpdating = True ActiveWorkbook.Save 'INSTRUCCION DE GRABAR ARCHIVO REGISTRO EN COMPUTADOR DE NATHALIA AQUI Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False Sheets("VISITAS").Select End Sub