Si es verdad que funcionaba mal. Es que después de probar añadí unas líneas que suelen molestar en al fase de pruebas y una de ellas la escribí mal. Puse una
Application.EnableEvents = False
donde tenía que haber puesto
Application.EnableEvents = True
Y el efecto era que el programa ya no tenía en cuenta los eventos de cambio de datos.
Incluso verás que he añadido una macro EnablearEvents que a mí me ha venido bien para la fase de pruebas pero que no te hará falta.
Aparte de corregir eso he modificado la macro para adaptarla a la columna C en lugar de la B y he corregido otra cosa que hacía mal y he añadido la opción de que te pregunta si quieres añadirlos o no. Y he intentado corregir todos esos errores que se pueden dar cuando introduces varios datos de golpe mediante pegado o borras varios a la vez, haciendo que los procese todos sin problemas.
El mecanismo consiste en que examina si hay repetidos cuando se introduce la cantidad en la columna C, luego mete siempre primero el código y luego la cantidad.
Pondré aquí la macro por si puede servirle a alguien, pero a ti te voy a mandar dentro de un rato el fichero con ella incorporada. A mi ese fichero me daba algún problema de Orígenes de Datos ODBC pero a ti no te los dará.
La macro está insertada en la hoja BaseDatos
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CeldaCodigo, Rango, Rango2, Celda As Range
Dim Lugar As String
Dim EstaRepe As Boolean
Dim Respuesta As Integer
If Not Intersect(Range("C:C"), Target) Is Nothing Then
For Each Celda In Target
Set CeldaCodigo = Celda.Offset(0, -2)
If Celda <> "" And CeldaCodigo <> "" Then
Lugar = CeldaCodigo.Address
Set Rango = Columns("A:A").Find(CeldaCodigo)
EstaRepe = False
If Rango.Address = Lugar Then
Set Rango2 = Rango
Set Rango = Columns("A:A").FindNext(Rango)
If Not Rango Is Nothing Then
If Rango.Address <> Rango2.Address Then EstaRepe = True
End If
Else
EstaRepe = True
End If
If EstaRepe Then
Respuesta = MsgBox("El codigo " & CeldaCodigo & " ya existe en la fila " & Str(Rango.Row) & vbCrLf & _
VbCrLf & "¿Quiere sumar los datos en esa fila?", vbInformation + vbYesNo, "Datos Repetidos")
If Respuesta = vbYes Then
Application.EnableEvents = False
Cells(Rango.Row, Rango.Column + 2) = Cells(Rango.Row, Rango.Column + 2) + Celda.Value
Celda.Value = ""
CeldaCodigo.Value = ""
Application.EnableEvents = True
End If
End If
End If
Next Celda
Set Rango = Nothing
Set Rango2 = Nothing
Set CeldaCodigo = Nothing
End If
End Sub
Y eso es todo, espera que te mando el fichero y ojala te sirva. Si no entiendes algo me lo preguntas. Y si ys está bien no olvides puntuar.