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