Convertir fechas sin barras en formato fecha dd/mm/yyyy

[solbete]

Buenas noches,

Necesito una ayudita. Tengo un archivo excel con una macro que convierte los datos introducidos en columna A y B en fechas cada vez que introduzco una fecha sin barras. 

Por ejemplo, si introduzco 020219(ddmmyy)  me lo convierte en 02/02/2019 (dd/mm/yyyy) automaticamente.

Solo lo convierte si introduzco los datos uno a uno. Necesito cambiar la configuración para que haga lo mismo pero solo si pincho en un botón de comando. Si no pulso ese botón no haga cambios

Este es el código que utilizo con el metodo " Worksheet_Change" y Tarjet

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngData As Range

Set rngData = Range("A2:A65536")

On Error Resume Next

If Union(Target, rngData).Address = rngData.Address Then

Application.EnableEvents = False

Target.ClearFormats

Select Case Len(Target)
Case 8
Target = DateSerial(Right(Target, 4), Mid(Target, 3, 2), Left(Target, 2))
Case 7
Target = DateSerial(Right(Target, 4), Mid(Target, 2, 2), Left(Target, 1))
Case Else
MsgBox "Entrada Incorrecta"
End Select

Application.EnableEvents = True

End If


On Error GoTo 0

End Sub

Adjunto archivo. ¿Alguien sabe como hacerlo?

Gracias por vuestra ayuda

ConversionFechasSinBarras.xlsm

[Abraham Valencia]

Hola

Siguiendo con tu forma de hacerlo y suponiendo que quieres cambiar la celda activa, solo asigna esto a un botón:

Sub Cambiar()

Select Case Len(ActiveCell)
Case 8
ActiveCell = DateSerial(Right(ActiveCell, 4), Mid(ActiveCell, 3, 2), Left(ActiveCell, 2))
Case 7
ActiveCell = DateSerial(Right(ActiveCell, 4), Mid(ActiveCell, 2, 2), Left(ActiveCell, 1))
Case Else
MsgBox "Entrada Incorrecta"
End Select

End Sub

Abraham Valencia

[solbete]

Gracias Abraham, 

Está genial, solo que debe aplicarlo a toda una columna, no a la celda activa

Gracias por tu ayuda

[Abraham Valencia]

Suponiendo que hablas de la columna A:

Sub Cambiar()

Dim UltimaFila As Long
Dim Celda As Range

Let UltimaFila = Cells(Rows.Count, 1).End(xlUp).Row

For Each Celda In ActiveSheet.Range("A1:A" & UltimaFila)

    If IsNumeric(Celda.Value) Then
        Select Case Len(Celda.Value)
            Case 8
                Celda = DateSerial(Right(Celda, 4), Mid(Celda, 3, 2), Left(Celda, 2))
            Case 7
                Celda = DateSerial(Right(Celda, 4), Mid(Celda, 2, 2), Left(Celda, 1))
        End Select
    End If
    
Next Celda

End Sub

Abraham Valencia

[solbete]

Ahora sí, muchas gracias. Me estaba volviendo loco probando todo tipo de cogidos.

Un saludo