Error 1004 en tiempo de ejecución en una macro de excel.

Dante Amor:

Tengo un problema con la macro que me enviaste hace unos días y desconozco la causa. Me ha funcionado correctamente con todos los datos que he introducido, pero con los datos de dos archivos en concreto me da el siguiente error:

Se ha producido el error '1004' en tiempo de ejecución:

Error definido por la aplicación o el objeto

Al depurar me marca las siguientes dos líneas:

H1. Range(h1. Cells(ini, "C"), h1. Cells(fin, "C")).Copy _
H2. Cells(destino, "C")

Te envío también el archivo por mail por si puedes echarle un vistazo.

Desconozco cual puede ser el problema. ¿Puedes orientarme un poco?.

1 Respuesta

Respuesta
3

Te anexo la actualización de la macro. El problema es porque en el archivo original las fechas estaban así: 01/12/2008 y en los archivo con problemas las fechas están así: 01/04/2007 08:15:00 a.m., pero con la actualización no importa cómo se encuentre la fecha.

Cambia las macros por estas.

Sub Procesar()
'Por.Dante Amor
    Dim f1 As Date, f2 As Date
    Application.ScreenUpdating = False
    Set h1 = Sheets("Datos originales")
    Set h2 = Sheets("Resultado")
    '
    'limpiar datos
    '
    u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row + 2
    h2.Range("A3:C" & u).ClearContents
    año = Year(h1.[A3])
    '
    'Poner fechas
    f1 = "01/01/" & año
    f2 = "31/12/" & año
    j = 3
    For i = f1 To f2
        h2.Cells(j, "A") = i
        j = j + 96
    Next
    '
    'Poner horas
    h2.[B3] = "00:00"
    h2.[B4] = "00:15"
    h2.[B3:B4].AutoFill h2.Range("B3:B" & j - 1), xlFillDefault
    h2.Range("C3:C" & j - 1) = 0
    '
    'Poner potencias
    potencias
    '
    h2.Select
    Application.ScreenUpdating = True
    MsgBox "Horarios completados"
End Sub
Sub potencias()
'Por.Dante Amor
    Set h1 = Sheets("Datos originales")
    Set h2 = Sheets("Resultado")
    Dim fecha As Date
    '
    u2 = h2.Range("B" & Rows.Count).End(xlUp).Row
    u1 = h1.Range("B" & Rows.Count).End(xlUp).Row + 1
    h1.Cells(u1, "A") = "x"
    fin = 0
    For i = 3 To u1
        If h1.Cells(i, "A") <> "" Then
            If fin > 0 Then
                h1.Range(h1.Cells(ini, "C"), h1.Cells(fin, "C")).Copy _
                h2.Cells(destino, "C")
                fin = 0
            End If
            ini = i
            If IsDate(h1.Cells(i, "A")) Then
                fecha = Format(h1.Cells(i, "A"), "dd/mm/yyyy")
            End If
            Set b = h2.Range("A3:A" & u2).Find(fecha)
            If Not b Is Nothing Then
                For j = b.Row To u2
                    hora1 = Hour(h1.Cells(i, "B"))
                    minu1 = Minute(h1.Cells(i, "B"))
                    hora2 = Hour(h2.Cells(j, "B"))
                    minu2 = Minute(h2.Cells(j, "B"))
                    If hora1 & minu1 = hora2 & minu2 Then
                        destino = j
                        Exit For
                    End If
                Next
            End If
        Else
            fin = i
        End If
    Next
    h1.Cells(u1, "A") = ""
End Sub

Saludos.Dante Amor

No olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas