Importar datos desde un archivo project a una hoja de excel

Os dejo una macro que accede a un fichero de microsoft project e importa el contenido de los principales campos que facilitan el seguimiento a una vista a filas de excel.

Sub Importa_Datos_Project_APM()
    Dim celda As String
    Dim trabajoReal As String
    Dim ETC As String
    Dim i As Integer
    Dim linea As Integer
    Dim specialTask As String
    Dim busco As Object
    Dim dur As Variant
    
    
    i = 1
    fila = 1
    
    Set appProj = CreateObject("MSProject.Application")
    appProj.FileOpenEx Name:="D:\xxxxxxxxxxxxxx.mpp"
    Set ActiveProject = appProj.ActiveProject
        
    Sheets("Planificacion").Select
    'Formateamos la hoja con estilos personalizados
    Application.ActiveSheet.Range("A1:Z100000").ClearContents
    Application.ActiveSheet.Range("A1:Z100000").Font.Name = "Calibri"
    Application.ActiveSheet.Range("A1:Z100000").Font.Size = "9"
    'Application.ActiveSheet.Range("A1:A13").Font.Color = vbWhite
    'Application.ActiveSheet.Range("A1:A13").Interior.Color = RGB(0, 143, 193)
    Range("A1:O1").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 12685056
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("N:O").Select
    Selection.Style = "Percent"

   'Importamos los datos del proyecto de desarrollo. Columna
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 1) = "TAREA"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 2) = "TIPO"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 3) = "NOMBRE TAREA"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 4) = "INICIO PREVISTO"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 5) = "INICIO REAL"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 6) = "FIN PREVISTO"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 7) = "FIN REAL"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 8) = "TRABAJO PREVISTO"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 9) = "TRABAJO REAL"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 10) = "DURACIÓN PREVISTA"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 11) = "DURACIÓN REAL"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 12) = "ESTADO"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 13) = "RECURSOS"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 14) = "DESV. TRABAJO"
    ActiveWorkbook.Sheets("Planificacion").Cells(fila, 15) = "DESV. DURACIÓN"
    fila = fila + 1
    
    For i = 1 To ActiveProject.Tasks.Count
        idTarea = ActiveProject.Tasks(i).Text11
        'Sólo importamos los datos con contenido en la columna Text11
        If idTarea <> "" Then
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 1) = ActiveProject.Tasks(i).Text3
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 2) = ActiveProject.Tasks(i).Text11
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 3) = ActiveProject.Tasks(i).Name
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 4) = Mid(ActiveProject.Tasks(i).BaselineStart, 4, 2) & "/" & Mid(ActiveProject.Tasks(i).BaselineStart, 1, 2) & "/" & Mid(ActiveProject.Tasks(i).BaselineStart, 7, 4)
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 5) = Mid(ActiveProject.Tasks(i).Start, 4, 2) & "/" & Mid(ActiveProject.Tasks(i).Start, 1, 2) & "/" & Mid(ActiveProject.Tasks(i).Start, 7, 4)
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 6) = Mid(ActiveProject.Tasks(i).BaselineFinish, 4, 2) & "/" & Mid(ActiveProject.Tasks(i).BaselineFinish, 1, 2) & "/" & Mid(ActiveProject.Tasks(i).BaselineFinish, 7, 4)
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 7) = Mid(ActiveProject.Tasks(i).Finish, 4, 2) & "/" & Mid(ActiveProject.Tasks(i).Finish, 1, 2) & "/" & Mid(ActiveProject.Tasks(i).Finish, 7, 4)
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 8) = ActiveProject.Tasks(i).BaselineWork / 60
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 9) = ActiveProject.Tasks(i).Work / 60
            fechai = ActiveWorkbook.Sheets("Planificacion").Cells(fila, 4)
            fechaf = ActiveWorkbook.Sheets("Planificacion").Cells(fila, 6)
            If fechai = "/NO/" Or fechaf = "/NO/" Then
                dur = "/NO/"
            Else
                dur = Application.WorksheetFunction.NetworkDays(fechai, fechaf)
            End If
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 10) = dur
            fechai = ActiveWorkbook.Sheets("Planificacion").Cells(fila, 5)
            fechaf = ActiveWorkbook.Sheets("Planificacion").Cells(fila, 7)
            If fechai = "/NO/" Or fechaf = "/NO/" Then
                dur = "/NO/"
            Else
                dur = Application.WorksheetFunction.NetworkDays(fechai, fechaf)
            End If
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 11) = dur
            Select Case ActiveProject.Tasks(i).Status
            Case "0"
                estado = "Completada"
                ActiveWorkbook.Sheets("Planificacion").Cells(fila, 12).Interior.Color = vbGreen
            Case "1"
                estado = "Según lo programado"
                ActiveWorkbook.Sheets("Planificacion").Cells(fila, 12).Interior.Color = vbWhite
            Case "2"
                estado = "Retrasada"
                ActiveWorkbook.Sheets("Planificacion").Cells(fila, 12).Interior.Color = vbRed
            Case "3"
                estado = "Desactivada"
                ActiveWorkbook.Sheets("Planificacion").Cells(fila, 12).Interior.ColorIndex = 15
            End Select
            ActiveWorkbook.Sheets("Planificacion").Cells(fila, 12) = estado 'ActiveProject.Tasks(i).Status
            
            Nombre = ActiveProject.Tasks(i).ResourceNames
            pos& = InStr(1, Nombre, "[")
            If pos& <> 0 Then
                ActiveWorkbook.Sheets("Planificacion").Cells(fila, 13) = Left(Nombre, pos& - 1)
            Else
                ActiveWorkbook.Sheets("Planificacion").Cells(fila, 13) = Nombre
            End If
            
            
            If ActiveProject.Tasks(i).BaselineWork <> 0 Then
                ActiveWorkbook.Sheets("Planificacion").Cells(fila, 14) = ((ActiveProject.Tasks(i).Work / 60) - (ActiveProject.Tasks(i).BaselineWork / 60)) / (ActiveProject.Tasks(i).BaselineWork / 60)
            Else
                ActiveWorkbook.Sheets("Planificacion").Cells(fila, 14) = "NOD"
            End If
                       
            If ActiveProject.Tasks(i).BaselineDuration <> 0 Then
                ActiveWorkbook.Sheets("Planificacion").Cells(fila, 15) = ((ActiveWorkbook.Sheets("Planificacion").Cells(fila, 11)) - (ActiveWorkbook.Sheets("Planificacion").Cells(fila, 10))) / (ActiveWorkbook.Sheets("Planificacion").Cells(fila, 10))
            Else
                ActiveWorkbook.Sheets("Planificacion").Cells(fila, 15) = "NOD"
            End If
            
            fila = fila + 1
        End If
        
    Next i
    


    
    appProj.Quit
End Sub