Muca Costa

Veja se dá pra adaptar às suas necessidades... Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Then Exit Sub If Target.Row <> 5 Then Exit Sub If Range("A5") <> "" Then Range("A1:A5").Interior.ColorIndex = 6 Else Range("A1:A5").Interior.ColorIndex = 0 End If End Sub

Tente assim: Sub Duplica_e_Renomeia() Dim Plan As Worksheet Dim NovaPlan As Worksheet Dim P As String Set DuplPlan = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) With ActiveSheet P = .Cells(.Rows.Count, "F").End(xlUp).Row + 1 End With DuplPlan = InputBox("Digite o nome da planilha que deseja duplicar:", "DUPLICAR PLANILHA!") 'Faz uma cópia da planilha Sheets(DuplPlan).Copy After:=Sheets(ThisWorkbook.Worksheets.Count) Set Plan = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) Plan.Name = InputBox("Digite o nome da nova planilha:", "NOVA PLANILHA!", Plan.Name) MsgBox "Planilha " & Plan.Name & " foi criada!" Sheets("OS's").Select Range("F" & P).Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _ Plan.Name & "!A1", TextToDisplay:=Plan.Name End Sub

Veja se o anexo lhe ajuda... ExemploVBA-TextBox.rar

Tente assim; Sub ExcluirZeros() Dim LR As Long, k As Long LR = Cells(Rows.Count, "X").End(xlUp).Row Application.ScreenUpdating = False For k = LR To 1 Step -1 If Cells(k, "X").Value <> "" Then c1 = Cells(k, "X").Replace("0", "", xlPart) End If Next k Application.ScreenUpdating = True Range("A1").Select End Sub

Veja se o anexo lhe ajuda... FormatoValor.rar

1) PERGUNTA: A Sub Excluir é uma macro independente, não tem nada com a Sub Listar_arquivos. É só pra auxiliar no resultado final... 2) PERGUNTA: Dá uma pesquisada...

Veja aqui: http://excelevba.com.br/formato-moeda-no-textbox-enquanto-digita/

1) DÚVIDA - Se tiver outros caracteres a excluir, ficaria c1, c2,..... c1 = Cells(k, "B").Replace("----- ", "", xlPart) c2 = Cells(k, "B").Replace("- ", "", xlPart) ............................................................ 2) DÚVIDA - Veja aqui: https://docs.microsoft.com/pt-br/office/vba/language/reference/user-interface-help/name-statement

Na realidade sou um autodidata, vou na coragem me aventurando em VBA(Access, word, Excel), Python, LibreOffice, ... Minhas maiores fontes de pesquisas são participar de Fóruns(perguntando e/ou respondendo) e, principalmente, Internet... Boa sorte.

Desculpe, não tinha percebido que ----- fica colado...

se tirar o espaço, vai ficar assim Aula 69 - Geometria Espacial Métrica - Cilindros Pate 1.avi ou seja, com dois espaços antes de Geometria

Não sei como está procedendo, mas aqui funcionou perfeitamente. Testei com três arquivos word: Aula 69 - ----- Geometria Espacial Métrica - Cilindros Pate 1.docx Aula 69 - ----- Geometria Espacial Métrica - Cilindros Pate 2.docx Aula 69 - ----- Geometria Espacial Métrica - Cilindros Pate 3.docx A macro renomeia para: Aula 69 - Geometria Espacial Métrica - Cilindros Pate 1.docx Aula 69 - Geometria Espacial Métrica - Cilindros Pate 2.docx Aula 69 - Geometria Espacial Métrica - Cilindros Pate 3.docx

Veja se o anexo ajuda... MoverOrdenar.rar

Testei aqui e está normal. Estou reenviando... RenomearArquivos.rar

Veja se o anexo ajuda... RenomearArquivos.rar

Veja o anexo e faça as adaptações necessárias para seu objetivo... mov-cursor.rar

Desculpe a pergunta, mas qual é a finalidade do projeto?

Salvo engano, o código está fazendo exatamente isso... Veja o anexo: MoverCriterioCores.rar

Tente assim: Private Sub Worksheet_Change(ByVal Target As Range) Dim cell As Range On Error GoTo Trata_Erro For Each cell In Selection If cell.Interior.Color = 11854022 Then ActiveCell.Offset(-1, 1).Select ElseIf cell.Interior.Color = 14277081 Then ActiveCell.Offset(0, 0).Select Else Exit Sub Trata_Erro: Exit Sub End If Next cell End Sub

Click Alt + F11 2 click's em Planilha1 Cole o código abaixo: Private Sub Worksheet_Change(ByVal Target As Range) Dim cell As Range For Each cell In Selection If cell.Interior.Color = 11854022 Then ActiveCell.Offset(-1, 1).Select ElseIf cell.Interior.Color = 14277081 Then ActiveCell.Offset(0, 0).Select Else Exit Sub End If Next cell End Sub

Veja se ajuda... Public Sub Mover() Dim cell As Range For Each cell In Selection If cell.Interior.Color = 11854022 Then ActiveCell.Offset(0, 1).Select ElseIf cell.Interior.Color = 14277081 Then ActiveCell.Offset(1, 0).Select Else MsgBox "Fim" End If Next cell End Sub

Veja se é isso: DUVIDA 02.xlsx

... porém tais valores só deveriam aparecer quando o código selecionado fosse 72132 ... tente assim: em g3 =se($f$3=72132;índice(d:d;corresp($f$3;a:a;0)+corresp("pedreiro com encargos complementares";indireto("b"&corresp($f$3;a:a;0)&":b20");0)-1);"") em h3 =se($f$3=72132;índice(d:d;corresp($f$3;a:a;0)+corresp("servente com encargos complementares";indireto("b"&corresp($f$3;a:a;0)&":b20");0)-1);"")

substitua Agora() por Data() STATUSDODOCUMENTO: SeImed([DATADAREVISAO]="";"Em elaboração";SeImed(Data()>[PROXIMAREVISAO];"Vencido";SeImed(Data()>[PROXIMAREVISAO]-30;"Vencendo";SeImed(Data()-[PROXIMAREVISAO]+30;"Vigente")))) Aqui SeImed(Data()-[PROXIMAREVISAO]+30;"Vigente" , o resultado de Data()-[PROXIMAREVISAO]+30 será um número e não data; também está faltando a condição (resultado MAIOR, MENOR ou IGUAL que algum critério)

O arquivo tem 20 abas, então seria de 3 a 20 e não de 3 a 18 Sheets(Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20)).Select