fabioceolin

Na parte de reprocessos da planilha tem uma macro chamado "OQU_Periodo", ele verifica o conteúdo das células do lado e faz umas contas mas ele apaga tudo o que esta calculado e calcula novamente eu gostaria de alterar para que ele começa-se a fazer as contas a partir da célula que esta em branco pois ele faz isso em tres planilhas o que acaba levando muito tempo para fazer. https://www.sendspace.com/file/fq7u72

Boa Noite! Pessoal eu tenho esse macro rodando mas ele demora muito pois ele apaga todos valores pra preencher de novo, queria que ele adiciona-se os valores a partir da celula em que esta em branco mas não estou conseguindo fazer, teria como dar uma ajuda? segue o codigo: Sub OQU_Periodo() Dim Row, Col, RowR, ColR, Lim As Integer Dim Soma As Double 'Macro Totaliza OQU reprocessado por período conforme frequencia de análise estabelecida 'MA-1 Row = 6 RowR = 6 Sum = 0 Lim = 6 Range("G6").Select Selection.End(xlDown).Select Lim = ActiveCell.Row Range("A6:I1000").Select ActiveWorkbook.Worksheets("Reprocesso").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Reprocesso").Sort.SortFields.Add Key:=Range( _ "G6:G1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("Reprocesso").Sort .SetRange Range("A5:I1000") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("L6:L1000").Select Selection.ClearContents Range("L6").Select Do While Range(Cells(Row, 11), Cells(Row, 11)).Value < Range("G1").Value If RowR <= Lim Then If Range(Cells(RowR, 7), Cells(RowR, 7)).Value < Range(Cells(Row, 11), Cells(Row, 11)).Value Then Sum = Sum + Range(Cells(RowR, 5), Cells(RowR, 5)) RowR = RowR + 1 Else Range(Cells(Row, 12), Cells(Row, 12)).Value = Sum Sum = 0 Row = Row + 1 End If Else Range(Cells(Row, 12), Cells(Row, 12)).Value = Sum Sum = 0 Row = Row + 1 End If Loop 'MA-2 Row = 6 RowR = 6 Sum = 0 Lim = 6 Range("T6").Select Selection.End(xlDown).Select Lim = ActiveCell.Row Range("N6:V1000").Select ActiveWorkbook.Worksheets("Reprocesso").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Reprocesso").Sort.SortFields.Add Key:=Range( _ "T6:T1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("Reprocesso").Sort .SetRange Range("N5:V1000") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("Y6:Y1000").Select Selection.ClearContents Range("Y6").Select Do While Range(Cells(Row, 24), Cells(Row, 24)).Value < Range("G1").Value If RowR <= Lim Then If Range(Cells(RowR, 20), Cells(RowR, 20)).Value < Range(Cells(Row, 24), Cells(Row, 24)).Value Then Sum = Sum + Range(Cells(RowR, 18), Cells(RowR, 18)) RowR = RowR + 1 Else Range(Cells(Row, 25), Cells(Row, 25)).Value = Sum Sum = 0 Row = Row + 1 End If Else Range(Cells(Row, 25), Cells(Row, 25)).Value = Sum Sum = 0 Row = Row + 1 End If Loop 'MA-3 Row = 6 RowR = 6 Sum = 0 Lim = 6 Range("AG6").Select Selection.End(xlDown).Select Lim = ActiveCell.Row Range("AA6:AI1000").Select ActiveWorkbook.Worksheets("Reprocesso").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Reprocesso").Sort.SortFields.Add Key:=Range( _ "AG6:AG1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("Reprocesso").Sort .SetRange Range("AA5:AI1000") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("AL6:AL1000").Select Selection.ClearContents Range("AL6").Select Do While Range(Cells(Row, 37), Cells(Row, 37)).Value < Range("G1").Value If RowR <= Lim Then If Range(Cells(RowR, 33), Cells(RowR, 33)).Value < Range(Cells(Row, 37), Cells(Row, 37)).Value Then Sum = Sum + Range(Cells(RowR, 31), Cells(RowR, 31)) RowR = RowR + 1 Else Range(Cells(Row, 38), Cells(Row, 38)).Value = Sum Sum = 0 Row = Row + 1 End If Else Range(Cells(Row, 38), Cells(Row, 38)).Value = Sum Sum = 0 Row = Row + 1 End If Loop End Sub