Boi com Orgulho

Pessoal, boa noite! Estou tentando a alguns dias criar uma repetição na planilha do meu trabalho. A planilha funciona da seguinte maneira: - Ela classificar os títulos na ordem correta e retira os títulos pagos para outra. - A questão é que preciso fazer isso pra cada titulo pago, queria um jeito de deixar em uma repetição sempre que achasse um titulo pago, ele executaria novamente, até não haver nenhum. Segue o Codigo: Application.ScreenUpdating = False ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields. _ Clear ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields. _ Add2 Key:=Range("Tabela2[[Situação ]]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, CustomOrder:="PAGO", DataOption:=xlSortNormal ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(0, 176, 80) ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(169, 208, 142) ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(198, 224, 180) ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(172, 185, 202) With ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With linha = 4 If Cells(linha, 2) = "PAGO" Then Range("B4:N4").Select Selection.Cut Sheets("PAGO").Select Rows("90:90").Select Selection.EntireRow.Hidden = False Range("B90").Select ActiveSheet.Paste Rows("90:90").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Rows("90:90").Select Selection.EntireRow.Hidden = True Sheets("PO - BM").Select Rows("4:4").Select Selection.Delete Shift:=xlUp Range("B4").Select Rows("3:3").Select Selection.EntireRow.Hidden = False Selection.EntireRow.Hidden = True Sheets("PAGO").Select Rows("90:90").Select Selection.EntireRow.Hidden = True Sheets("PO - BM").Select Range("B4").Select ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields. _ Clear ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(0, 176, 80) ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(169, 208, 142) ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(198, 224, 180) ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(172, 185, 202) With ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Sheets("PAGO").Select Range("B3:B8").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With ActiveWorkbook.Worksheets("PAGO").ListObjects("Tabela26").Sort.SortFields.Clear ActiveWorkbook.Worksheets("PAGO").ListObjects("Tabela26").Sort.SortFields.Add2 _ Key:=Range("Tabela26[Data de Pamento]"), SortOn:=xlSortOnValues, Order:= _ xlDescending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("PAGO").ListObjects("Tabela26").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("N3").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=[@Previsão]" Range("N4").Select ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 ActiveWindow.SmallScroll Down:=-111 Range("N3").Select Selection.NumberFormat = "m/d/yyyy" Sheets("PO - BM").Select ActiveWindow.SmallScroll Down:=-33 Range("B4").Select Dim Feito As VbMsgBoxResult Feito = MsgBox("Planilha Atualizada /1 NF foi movida para PAGO") Else Rows("3:3").Select Selection.EntireRow.Hidden = False Selection.EntireRow.Hidden = True Sheets("PAGO").Select Rows("90:90").Select Selection.EntireRow.Hidden = True Sheets("PO - BM").Select Range("B4").Select ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields. _ Clear ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(0, 176, 80) ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(169, 208, 142) ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(198, 224, 180) ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort.SortFields.Add _ (Range("Tabela2[[Situação ]]"), xlSortOnCellColor, xlAscending, , xlSortNormal) _ .SortOnValue.Color = RGB(172, 185, 202) With ActiveWorkbook.Worksheets("PO - BM").ListObjects("Tabela2").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Dim Condição As VbMsgBoxResult Condição = MsgBox("Planilha Atualizada / Nenhuma NF paga encontrada") End If Sheets("PAGO").Select Range("B3:B8").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 Range("B4").Select Sheets("PO - BM").Select ActiveWindow.SmallScroll Down:=-33 Range("B4").Select End With Application.ScreenUpdating = True End Sub