Macro para convertir un Gantt en un Check List

Modulo B_Calcular_1_Analisis:

Option Explicit

Dim Bcle As LongDim Fila_Inicio As Long 'Presupuesto | ProgramaDim UltLinea As Long 'Presupuesto | ProgramaDim UltLinea_Plan As Long 'Analisis PlaneadoDim Temp_N As LongDim Temp_Range As RangePublic Sub Calcular() 'ANALISIS DE LO PLANEADOA_Declarar_Constantes.DeclararFila_Inicio = 6 'Inicio Planilla Presupuesto | PlanUltLinea = Sheets("Presupuesto | Programa").Range("A" & Rows.Count).End(xlUp).RowUltLinea_Plan = Sheets("01_Analisis").Range("A" & Rows.Count).End(xlUp).RowTemp_N = 2 ' El inicio de la planilla de Presupuesto PlaneadoIf Regla = "50%-50%" Then    'Borro todo antes de escribir    Sheets("01_Analisis").Range(Sheets("01_Analisis").Cells(2, 1), Sheets("01_Analisis").Cells(UltLinea_Plan, 15)).Clear    For Bcle = Fila_Inicio To UltLinea        With Sheets("01_Analisis")            .Cells(Temp_N, 1) = "PV"            .Cells(Temp_N, 2) = Sheets("Presupuesto | Programa").Cells(Bcle, 3)            .Cells(Temp_N, 3) = Sheets("Presupuesto | Programa").Cells(Bcle, 1)            .Cells(Temp_N, 4) = Sheets("Presupuesto | Programa").Cells(Bcle, 2)            .Cells(Temp_N, 5) = 0.5            .Cells(Temp_N, 6) = 0.5 * Val(Sheets("Presupuesto | Programa").Cells(Bcle, 5))            Temp_N = Temp_N + 1                        .Cells(Temp_N, 1) = "PV"            .Cells(Temp_N, 2) = Sheets("Presupuesto | Programa").Cells(Bcle, 4)            .Cells(Temp_N, 3) = Sheets("Presupuesto | Programa").Cells(Bcle, 1)            .Cells(Temp_N, 4) = Sheets("Presupuesto | Programa").Cells(Bcle, 2)            .Cells(Temp_N, 5) = 1            .Cells(Temp_N, 6) = 0.5 * Val(Sheets("Presupuesto | Programa").Cells(Bcle, 5))            Temp_N = Temp_N + 1        End With    Next
    For Bcle = Fila_Inicio To UltLinea 'CALCULO DE LO REAL        With Sheets("01_Analisis")            'Doy Formato las celdas donde pondré los datos             If CDate(Sheets("Presupuesto | Programa").Cells(Bcle, 8)) > 1 And CDate(Sheets("Presupuesto | Programa").Cells(Bcle, 9)) > 1 Then                .Cells(Temp_N, 1) = "AC"                .Cells(Temp_N, 2) = Sheets("Presupuesto | Programa").Cells(Bcle, 8)                .Cells(Temp_N, 3) = Sheets("Presupuesto | Programa").Cells(Bcle, 1)                .Cells(Temp_N, 4) = Sheets("Presupuesto | Programa").Cells(Bcle, 2)                .Cells(Temp_N, 5) = 0.5                .Cells(Temp_N, 6) = 0.5 * Val(Sheets("Presupuesto | Programa").Cells(Bcle, 11))                Temp_N = Temp_N + 1                .Cells(Temp_N, 1) = "AC"                .Cells(Temp_N, 2) = Sheets("Presupuesto | Programa").Cells(Bcle, 9)                .Cells(Temp_N, 3) = Sheets("Presupuesto | Programa").Cells(Bcle, 1)                .Cells(Temp_N, 4) = Sheets("Presupuesto | Programa").Cells(Bcle, 2)                .Cells(Temp_N, 5) = 0.5                .Cells(Temp_N, 6) = 0.5 * Val(Sheets("Presupuesto | Programa").Cells(Bcle, 11))                Temp_N = Temp_N + 1            End If            If CDate(Sheets("Presupuesto | Programa").Cells(Bcle, 8)) > 1 And CDate(Sheets("Presupuesto | Programa").Cells(Bcle, 9)) = 0 Then                .Cells(Temp_N, 1) = "AC"                .Cells(Temp_N, 2) = Sheets("Presupuesto | Programa").Cells(Bcle, 8)                .Cells(Temp_N, 3) = Sheets("Presupuesto | Programa").Cells(Bcle, 1)                .Cells(Temp_N, 4) = Sheets("Presupuesto | Programa").Cells(Bcle, 2)                .Cells(Temp_N, 5) = 0.5                .Cells(Temp_N, 6) = Val(Sheets("Presupuesto | Programa").Cells(Bcle, 11))                Temp_N = Temp_N + 1            End If        End WithNext    For Bcle = Fila_Inicio To UltLinea 'CALCULO DEL EV        With Sheets("01_Analisis")             If CDate(Sheets("Presupuesto | Programa").Cells(Bcle, 8)) > 0 Then                .Cells(Temp_N, 1) = "EV"                .Cells(Temp_N, 2) = Sheets("Presupuesto | Programa").Cells(Bcle, 8)                .Cells(Temp_N, 3) = Sheets("Presupuesto | Programa").Cells(Bcle, 1)                .Cells(Temp_N, 4) = Sheets("Presupuesto | Programa").Cells(Bcle, 2)                .Cells(Temp_N, 5) = 0.5                .Cells(Temp_N, 6) = 0.5 * Val(Sheets("Presupuesto | Programa").Cells(Bcle, 5))                Temp_N = Temp_N + 1            End If             If CDate(Sheets("Presupuesto | Programa").Cells(Bcle, 9)) > 1 Then                .Cells(Temp_N, 1) = "EV"                .Cells(Temp_N, 2) = Sheets("Presupuesto | Programa").Cells(Bcle, 9)                .Cells(Temp_N, 3) = Sheets("Presupuesto | Programa").Cells(Bcle, 1)                .Cells(Temp_N, 4) = Sheets("Presupuesto | Programa").Cells(Bcle, 2)                .Cells(Temp_N, 5) = 1                .Cells(Temp_N, 6) = 0.5 * Val(Sheets("Presupuesto | Programa").Cells(Bcle, 5))                Temp_N = Temp_N + 1            End If        End With    NextEnd IfSheets("01_Analisis").Cells(Temp_N, 1) = "EV"Sheets("01_Analisis").Cells(Temp_N, 2) = Date_Analisis        With Sheets("01_Analisis")            .Cells(Temp_N, 1).EntireColumn.NumberFormat = "@"            .Cells(Temp_N, 2).EntireColumn.NumberFormat = "dd-mmm 'yy"            .Cells(Temp_N, 3).EntireColumn.NumberFormat = "@"            .Cells(Temp_N, 4).EntireColumn.NumberFormat = "@"            .Cells(Temp_N, 5).EntireColumn.NumberFormat = "0 %"            .Cells(Temp_N, 6).EntireColumn.NumberFormat = "$ * #,##0"        End WithSet Temp_Range = Sheets("01_Analisis").Range(Sheets("01_Analisis").Cells(1, 1), Sheets("01_Analisis").Cells(Temp_N, 6))If Temp_Range.AutoFilter = True Then    ActiveWorkbook.Worksheets("01_Analisis").AutoFilterMode = FalseEnd If    Temp_Range.AutoFilter    ActiveWorkbook.Worksheets("01_Analisis").AutoFilter.Sort.SortFields.Clear    ActiveWorkbook.Worksheets("01_Analisis").AutoFilter.Sort.SortFields.Add Key:=Range("B9:B49"), SortOn:=xlSortOnValues, Order:=xlAscending, _        DataOption:=xlSortNormal    With ActiveWorkbook.Worksheets("01_Analisis").AutoFilter.Sort        .Header = xlYes        .MatchCase = False        .Orientation = xlTopToBottom        .SortMethod = xlPinYin        .Apply    End With    ActiveWindow.SmallScroll Down:=15End Sub

Si te interesa dale al botón G+, comenta, participa...

Y escribime para enviarte el ejemplo!