renombrar hoja y que no duplique el nombre si ya existe en el rango seleccionado para el nombre

publicado el 23 de junio5 años

hola buenos dias,

tengo una macro que copia una hoja( ingreso), me copia el contenido y renombra la hoja con fecha del informe pero el problema que se me genera es cuando no modifico la fecha sigue corriendo la macro me crea otra hoja pero no renombra la hoja con la fecha porque ya existe en otra. mi consulta es

¿ cómo puedo hacer para que se detenga la macro y que me avise en un mensaje que la fecha del informe ya existe y no se puede guardar ? para solucionar el problema

adjunto la macro

Sub guardar()

Application.ScreenUpdating = False

Sheets("ingreso").Copy After:=Sheets(1)
ActiveSheet.Name = Range("d13")
Sheets("ingreso").Select

Application.ScreenUpdating = True

Range("c19:e38").ClearContents

MsgBox ("guardado con éxito!!!!")

End Sub

GRACIAS de antemano por la ayuda !!!!!

quedo atento a comentarios

Editado el el 23 de junio5 años por MIJAF35
rectificar redacción

publicado el 23 de junio5 años

Hola @MIJAF35, puedes encerrar tu código dentro de este:

On Error Resume Next
Set hoja = Sheets("Prueba3")

If Err.Number = 9 Then

' Aqui coloca tu  código


End If

Saludos.

publicado el 23 de junio5 años

Autor

Hace 23 minutos , AlexanderS dijo:

On Error Resume Next Set hoja = Sheets("Prueba3") If Err.Number = 9 Then

Gracias por tu pronta respuesta pero como podria incluir en mi macro, no me resulta soy novato no se en que linea debo colocarla y el mensaje " fecha del informe ya existe y no se puede guardar"

Editado el el 23 de junio5 años por MIJAF35
rectificar redacción

publicado el 23 de junio5 años

Ahora mismo, MIJAF35 dijo:

como podria incluir en mi macro, no me resulta soy novato no se en que linea debo colocarla

Se me fue ese detalle con el nombre de la hoja no es Sheets("Prueba3"), lo correcto es Sheets(Range("d13"))

Solo debes copiar tu código dentro del que que yo te pase, así:

Sub guardar()

Application.ScreenUpdating = False

On Error Resume Next
Set hoja = Sheets(Range("d13"))

If Err.Number = 9 Then

    Sheets("ingreso").Copy After:=Sheets(1)
    ActiveSheet.Name = Range("d13")
    Sheets("ingreso").Select

Application.ScreenUpdating = True

Range("c19:e38").ClearContents

MsgBox ("guardado con éxito!!!!")

End If

End Sub

Pruebalo así y me comentas.

Saludos

publicado el 23 de junio5 años

Y con el mensaje :

Sub guardar()

Application.ScreenUpdating = False

On Error Resume Next
Set hoja = Sheets(Range("d13"))

If Err.Number = 9 Then

    Sheets("ingreso").Copy After:=Sheets(1)
    ActiveSheet.Name = Range("d13")
    Sheets("ingreso").Select

Application.ScreenUpdating = True

Range("c19:e38").ClearContents

MsgBox ("guardado con éxito!!!!")

Else

MsgBox "Fecha del informe ya existe y no se puede guardar"

End If

End Sub

Saludos

publicado el 23 de junio5 años

Autor

Hace 5 minutos , AlexanderS dijo:


Sub guardar()

Application.ScreenUpdating = False

On Error Resume Next
Set hoja = Sheets(Range("d13"))

If Err.Number = 9 Then

    Sheets("ingreso").Copy After:=Sheets(1)
    ActiveSheet.Name = Range("d13")
    Sheets("ingreso").Select

Application.ScreenUpdating = True

Range("c19:e38").ClearContents

MsgBox ("guardado con éxito!!!!")

Else

MsgBox "Fecha del informe ya existe y no se puede guardar"

End If

End Sub

publicado el 23 de junio5 años

Autor

lo que me enviaste igual crea la copia de la hoja

este es el archivo

la idea es que no guarde si se duplica la fecha en la la celda "d13"

y si no es mucho pedir que en la copia de la hoja ingreso no se copie tambien el boton que genera la macro

y gracias por tus prontas respuestas amigo

Informe Ejecutivo de Actividades Diarias.xlsm

Editado el el 23 de junio5 años por MIJAF35
rectificar redacción

publicado el 23 de junio5 años

Con un ejemplo siempre es mejor!.

El código esta bien el problema es como tienes la fecha y el nombre de la hoja, la fecha en la celda tiene formato 10/7/2020 y la hoja se llama 10-7-2020 por lo que no son iguales, en los nombres de las hojas no se admite el carácter "/".

Prueba ahora con el archivo.

Comentas , saludos.

Informe Ejecutivo de Actividades Diarias.xlsm

publicado el 23 de junio5 años

Autor

Hace 6 minutos , AlexanderS dijo:

Con un ejemplo siempre es mejor!.

El código esta bien el problema es como tienes la fecha y el nombre de la hoja, la fecha en la celda tiene formato 10/7/2020 y la hoja se llama 10-7-2020 por lo que no son iguales, en los nombres de las hojas no se admite el carácter "/".

Prueba ahora con el archivo.

Comentas , saludos.

Informe Ejecutivo de Actividades Diarias.xlsm 52.71 kB · 0 descargas

Estimado le agradezco infinitamente su disposición, gracias.!!!!! . Era lo que necesitaba y me ayuda a seguir aprendiendo en este largo camino de las macros. Doy por tema cerrado

gracias

publicado el 23 de junio5 años

Hace 12 minutos , MIJAF35 dijo:

Estimado le agradezco infinitamente su disposición, gracias.!!!!! . Era lo que necesitaba y me ayuda a seguir aprendiendo en este largo camino de las macros. Doy por tema cerrado

gracias

Siempre es un gusto!! buen día

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

Domina Excel, de Cero a Experto

¿Atascado? Deja de buscar soluciones puntuales. Aprende a dominar Excel para siempre con nuestro curso online. Más de 115 lecciones y soporte directo.

Ver el Curso Completo

194 Archivos
100 Comentarios
30 Revisiones
Última descarga

Nuevo mapa de municipios españoles
- 3

Saludos

Esta es la primera vez que veo un foro pago, pero me da esperanzas de que aprenderé mucho aquí.

Por fernandoflr, · publicado el domingo a las 20:213 días
Crear un loop para emitir recibos

Por Corvette, · publicado el sábado a las 04:214 días
Crear un loop para emitir recibos

Hola! anoche estuve revisando, tuve que hacer unos pequeños ajustes en la direccion de la carpeta (en vez de poner la direccion en partes la coloque toda de corrido parecida a como estaba antes) y logramos (vos y yo) que funcione!. Tambien tuve que desactivar la linea de código que bloqueaba la hoja porque sino no estaba dejando que la macro escriba el codigo de la propiedad en la celda, pero eso es lo de menos, supongo que lo puedo solucionar poniendo el bloqueo al final de la macro que creaste o desprotegiendo la celda donde se pone el codigo de propiedad.
Así que doy por supuesto que eso lo voy a poder hacer funcionar por lo que entonces voy a marcar como que ya está solucionado lo que necesitaba.
Agradezco muchisimo tu ayuda porque era sumamente tedioso tener que estar haciendo los recibos de a uno ya que la macro de envio de recibos es medio lenta. Ahora no me importa si tarda mucho, apretaré el boton y le daré todo el tiempo que se quiera tomar mientras yo hago otra cosa.
Gracias nuevamente!!!!

Por Corvette, · publicado el 9 de diciembre9 dic
Crear un loop para emitir recibos

Prueba con tu código modificado

Por JSDJSD, · publicado el 5 de diciembre5 dic
Crear un loop para emitir recibos

Sub Imagen13_Haga_clic_en() Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single Dim rutaArchivo As String Dim Email As CDO.Message Dim t As Single Application.DisplayAlerts = False Application.ScreenUpdating = False ActiveSheet.Unprotect "4324" '--- GENERAR IMAGEN DEL RECIBO --- With Range("H7:R34") Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height .CopyPicture End With With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto) .Activate .Chart.Paste '---- RUTA DEL ARCHIVO (CORREGIDO) ---- rutaArchivo = "C:\Users\Usuario\Google Drive\LOCACIONES\REC. PROPIETARIOS\" & _ Format(Range("Q20"), "mmmYY") & " - " & _ Range("Q9") & " - " & _ Range("P17") & " - " & _ Range("K19") & ".JPG" .Chart.Export rutaArchivo .Delete End With 'Guardar ruta en AK30 por compatibilidad Range("AK30").Value = rutaArchivo '--- PEGAR BLOQUE DE DATOS --- Range("AH6").Copy Range("AH9").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Range("Y7:AI33").Copy Range("H7").PasteSpecial xlPasteAll ActiveSheet.Protect "4324" ActiveWorkbook.Save '--- PREPARAR ENVÍO DEL MAIL --- Set Email = New CDO.Message correo_origen = "nqn.negocios@gmail.com" Clave_correo_origen = "wkfhaapcnjljbwju" correo_destino = Range("AK27").Value Asunto = Range("AK28") Mensaje = Range("AK29") Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com" Email.Configuration.Fields(cdoSendUsingMethod) = 2 With Email.Configuration.Fields .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo_origen .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Clave_correo_origen .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True End With '--- VALIDAR ARCHIVO ANTES DE ENVIAR --- t = Timer Do While Dir(rutaArchivo) = "" And Timer - t < 5 DoEvents Loop If Dir(rutaArchivo) = "" Then MsgBox "ERROR: El archivo no se generó: " & rutaArchivo, vbCritical Exit Sub End If '--- ENVIAR MAIL --- With Email .To = correo_destino .From = correo_origen .Subject = Asunto .TextBody = Mensaje .Configuration.Fields.Update .AddAttachment rutaArchivo On Error Resume Next .Send End With End Sub Sub powerbuttonINQ() Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single Dim rutaArchivo As String Dim Email As CDO.Message Dim t As Single Application.DisplayAlerts = False Application.ScreenUpdating = False ActiveSheet.Unprotect "4324" '--- GENERAR IMAGEN DEL RECIBO --- With Range("H7:R33") Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height .CopyPicture End With With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto) .Activate .Chart.Paste rutaArchivo = "C:\Users\Usuario\Google Drive\LOCACIONES\REC. INQUILINOS\" & _ Format(Range("Q20"), "mmmYY") & " - " & _ Range("Q9") & " - " & _ Range("P17") & " - " & _ Range("J17") & ".JPG" .Chart.Export rutaArchivo .Delete End With Range("AK30").Value = rutaArchivo Range("AH6").Copy Range("AH9").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Range("Y7:AI33").Copy Range("H7").PasteSpecial xlPasteAll ActiveSheet.Protect "4324" ActiveWorkbook.Save '--- EMAIL CONFIG --- Set Email = New CDO.Message correo_origen = "nqn.negocios@gmail.com" Clave_correo_origen = "wkfhaapcnjljbwju" correo_destino = Range("AK27").Value Asunto = Range("AK28") Mensaje = Range("AK29") Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com" Email.Configuration.Fields(cdoSendUsingMethod) = 2 With Email.Configuration.Fields .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo_origen .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Clave_correo_origen .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True End With '--- VERIFICAR ARCHIVO --- t = Timer Do While Dir(rutaArchivo) = "" And Timer - t < 5 DoEvents Loop If Dir(rutaArchivo) = "" Then MsgBox "ERROR: El archivo no se generó: " & rutaArchivo, vbCritical Exit Sub End If '--- ENVIAR --- With Email .To = correo_destino .From = correo_origen .Subject = Asunto .TextBody = Mensaje .Configuration.Fields.Update .AddAttachment rutaArchivo On Error Resume Next .Send End With End Sub

Por JSDJSD, · publicado el 5 de diciembre5 dic

No hay usuarios registrado para ver esta página.

Conéctate a Ayuda Excel

renombrar hoja y que no duplique el nombre si ya existe en el rango seleccionado para el nombre

Featured Replies

Archivado

Archivos

Nuevo mapa de municipios españoles

Agenda Calendario Vintage

Cómo conservar la función AHORA()

Agenda v01

Gráficos de aranceles con colores difusos

Estadísticas de descargas

Mensajes

Saludos

Crear un loop para emitir recibos

Crear un loop para emitir recibos

Crear un loop para emitir recibos

Crear un loop para emitir recibos

Visualizado recientemente 0

Account

Navigation

Buscar

Configure browser push notifications

Chrome (Android)

Chrome (Desktop)

Safari (iOS 16.4+)

Safari (macOS)

Edge (Android)

Edge (Desktop)

Firefox (Android)

Firefox (Desktop)