Esta macro de mayúsculas me esta dando problemas

Esta macro de mayúsculas me esta dando problemas al eliminar celdas se me borran las celdas o líneas:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("A12:D41, H12:H46")) Is Nothing Then
Application.EnableEvents = False
Target.Value = VBA.UCase(Target.Text)
Application.EnableEvents = True
End If
End Sub

Al eliminar cuatro líneas, las líneas que suben más unas cuantas se me borran, también me borran las fórmulas y no me deja volver a escribirlas.

2 Respuestas

Respuesta
1

Utiliza el evento Change

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A12:D41, H12:H46")) Is Nothing Then
Application.EnableEvents = False
Target.Value = UCase(Target)
Application.EnableEvents = True
End If
End Sub

Si lo que quieres es poner en mayúsculas, los textos de esos rangos.

Si te ha valido la respuesta.

No me escribe en mayúsculas.

Un saludo

Si quieres pásame el fichero, a ver si tienes algún formato condicional en esas celdas o algo raro, pero a mi, se me ejecuta correctamente.

Respuesta
1

Te anexo completo el código del evento thisworkbook, hay que verificar que no tengas fórmula, para que no borre el contenido.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Select Case Sh.Name
        Case "Contado", "Adra Paco", "Balerma Trini", "El Ejido Adelina", "Berja Gador", "Adra Maria", "Iznajar Pepa", "Lucena Rafaela", "Lucena Carmen", "Benameji Juan", "Badolatosa Mª Jose", "Casariche Carmen", "Gilena Aurelia", "F. Piedra Antonia", "Humilladero Victoria", "Benameji Sole", "Galerias Fernandez", "Fuengirola Paco", "Fuengirola Charo", "Fuengirola Rosalia", "La Cala Antonia", "Marbella Juani", "Marbella Sara", "Flores Carmen", "Asuncion Maria", "Asuncion Pepi", "Asuncion Inma", "Asuncion Maria", "Asuncion Pepi", "Asuncion Inma", "Delicias Amparo", "La Paz Cris", "La Paz Paco", "La Luz J. Manuel", "Chapas Virginia Toñi", "P Sur Toñi", "Molinillo Meli", "Union Ramona Gema", "Huetor Mª Luisa", "Salar Carmen", "Loja Maribel", "Loja Paqui", "Loja Paqui", "Loja Mª Jose", "Moraleda Paqui", "Loja Pepa Marengo", "V Trabuco Charo", "A. Miel Manolo", "A. Miel Conchi Tere", "Torremolinos Paqui", "Torremolinos Fina", "Churriana Eva", "Pima", "Viajante PACO", "Viajante ORTIGOSA"
            If Not Intersect(Target, Range("A12:D41, H12:H46")) Is Nothing Then
                For Each c In Target
                    If c.HasFormula = False Then
                        Application.EnableEvents = False
                        c.Value = UCase(c.Value)            '  MAYUSCULAS TODO
                        Application.EnableEvents = True
                    End If
                Next
            End If
        Case "Listado", "Listado"
            If Not Intersect(Target, Range("A10:E6000")) Is Nothing Then
                For Each c In Target
                    If c.HasFormula = False Then
                        Application.EnableEvents = False
                        Target.Value = VBA.UCase(Target.Text)            '  MAYUSCULAS TODO
                        Application.EnableEvents = True
                    End If
                Next
            End If
    End Select
End Sub

Saludos.Dante Amor

Me faltó un detalle en la hoja "listado", Utiliza la siguiente, por favor:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Act.Por.Dante Amor
    Select Case Sh.Name
        Case "Contado", "Adra Paco", "Balerma Trini", "El Ejido Adelina", "Berja Gador", "Adra Maria", "Iznajar Pepa", "Lucena Rafaela", "Lucena Carmen", "Benameji Juan", "Badolatosa Mª Jose", "Casariche Carmen", "Gilena Aurelia", "F. Piedra Antonia", "Humilladero Victoria", "Benameji Sole", "Galerias Fernandez", "Fuengirola Paco", "Fuengirola Charo", "Fuengirola Rosalia", "La Cala Antonia", "Marbella Juani", "Marbella Sara", "Flores Carmen", "Asuncion Maria", "Asuncion Pepi", "Asuncion Inma", "Asuncion Maria", "Asuncion Pepi", "Asuncion Inma", "Delicias Amparo", "La Paz Cris", "La Paz Paco", "La Luz J. Manuel", "Chapas Virginia Toñi", "P Sur Toñi", "Molinillo Meli", "Union Ramona Gema", "Huetor Mª Luisa", "Salar Carmen", "Loja Maribel", "Loja Paqui", "Loja Paqui", "Loja Mª Jose", "Moraleda Paqui", "Loja Pepa Marengo", "V Trabuco Charo", "A. Miel Manolo", "A. Miel Conchi Tere", "Torremolinos Paqui", "Torremolinos Fina", "Churriana Eva", "Pima", "Viajante PACO", "Viajante ORTIGOSA"
            If Not Intersect(Target, Range("A12:D41, H12:H46")) Is Nothing Then
                For Each c In Target
                    If c.HasFormula = False Then
                        Application.EnableEvents = False
                        c.Value = UCase(c.Value)            '  MAYUSCULAS TODO
                        Application.EnableEvents = True
                    End If
                Next
            End If
        Case "Listado", "Listado"
            If Not Intersect(Target, Range("A10:E6000")) Is Nothing Then
                For Each c In Target
                    If c.HasFormula = False Then
                        Application.EnableEvents = False
                        Target.Value = UCase(c.Value)            '  MAYUSCULAS TODO
                        Application.EnableEvents = True
                    End If
                Next
            End If
    End Select
End Sub

Buenas tar des Dante.
En la hoja de "Listado" he puesto, la macro así:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Act.Por.Dante Amor
Case "Listado", "Listado"
If Not Intersect(Target, Range("A10:E6000")) Is Nothing Then
For Each c In Target
If c.HasFormula = False Then
Application.EnableEvents = False
Target.Value = UCase(c.Value) ' MAYUSCULAS TODO
Application.EnableEvents = True
End If
Next
End If
End Select
End Sub

Por que le he quitado, lo correspondiente a las facturas, pero la hoja listado, es una hoja que tengo que agregar líneas o quitarlas bastantes veces, entonces, ahora como me la has pasado mejora la anterior, al eliminar 4 filas me elimina las filas, pero las líneas que la sustituyen quedan borradas.
En cuanto a la de las facturas, te pongo otra pregunta, más especifica, si me lo permites.
Un saludo

Pon lo siguiente en el evento de la hoja "listado"

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
    If Not Intersect(Target, Range("A10:E6000")) Is Nothing Then
        For Each c In Target
            If c.HasFormula = False Then
                Application.EnableEvents = False
                c.Value = UCase(c.Value) ' MAYUSCULAS TODO
                Application.EnableEvents = True
            End If
        Next
    End If
End Sub

Decía target.value = y debe decir c.value=

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Abreviar con macro el código de cada hoja

Me podrían decir si este código que tiene cada página: Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A12:D41, H12:H46")) Is Nothing Then Application.EnableEvents = False Target.Value = VBA.UCase(Target.Text)...
1 respuesta

Modificar macro Excel para poner mayúsculas.

He copiado un macro para excel de Todo Expertos, para poner la primera letra de una oración en mayúscula y un punto final, funciona bien pero me gustacia aplicarlo solo a una celda o conjunto de ellas y no soy capaz de modificarlo, os agradecería...
1 respuesta

¿Cómo hacer para que en todos las celdas de excel acepte solo mayúsculas?

De nuevo yo por aquí, Quisiera saber como puedo hacer para que en todas las celdas de excel solo introduzca solo mayúsculas.
1 respuesta

Solo mayúsculas en una Hoja de Excel

Tengo un hoja de excel en la cual quiero que todo lo que se escriba sea en mayúsculas. ¿Qué puedo hacer para que la persona que use esta hoja no pueda escribir en minúsculas?
2 respuestas

Cambiar indistintamente el valor que comparten dos celdas ( II)

Lamentablemente la solución que me dió Elsa no me vale del todo: Private Sub Worksheet_Change(ByVal Target As Range) 'x Elsamatilde If Not Intersect(Target, Range("A1:A10")) Is Nothing Then Range("B" & Target.Row) = Target.Value ElseIf Not...
1 respuesta

Macro de mayúsculas, con un problema

Tengo esta macro para todo mayúsculas: Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range(" A12:A41,C12:C41")) Is Nothing Then Target.Value = AMayusculas(Target.Value) End If End Sub Y en un modulo: Public Function...
2 respuestas

Agrupando hojas anular la protección individual de cada hoja

En cada hoja del cliente tiene : Private Sub Worksheet_Activate() ActiveSheet.Protect Password:="1" End Sub Y claro no me deja rectificar todas la hojas a la vez. El código de la macro es : Sub Agrupar_hojas_clientes() ' Grabada el 03/09/2014 por...
1 respuesta

Sumar valor en misma celda

Como lo hago para que al introducir un valor en una celda me sume automáticamente 25. Es decir que al poner 100 en una celda me de esta misma 125
1 respuesta

Permitir solo determinado formato en celdas

Solicitando nuevamente te ayuda. Como podría hacer para que en una hoja de Excel llamada Datos, la columna A (Consecutivo) acepte solo números; la columna B (Descripción) acepte solo texto y por ultimo la columna C (Fecha) solo fechas. Ademas si al...
1 respuesta

Llamar macro con valores de celda

Tengo el siguiente código que ejecuta una macro al cambiar el volor de una celda en un derterminado rango: Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("k5:k300")) Is Nothing Then Exit Sub End If ' If Target >= 0...
1 respuesta