Esse macro do Aplicativo Microsoft Excel VBA, procura por determinada palavra em determinada coluna e a deleta, esses critérios são coletados a partir uma entrada de dados Inpubtox. Espero que o exemplo possam lhes ser útil, Fique com Deus,
Expedito Marcondes.

Sub sbx_deletar_linhas_baseado_criterios()

Dim vRange As Range, DeletaRange As Range, vColuna As Range
Dim vProcuraTexto As String, vProcuraColuna As String, vColunaAtiva As String
Dim PrimeiroEndereco As String, CheckaNulo As String
Dim SCA

[C1].Select ' Para selecionar a coluna(C),
'Extract active column as text

SCA = Split(ActiveCell.EntireColumn.Address(, False), ":")
vColunaAtiva = SCA(0)

vProcuraColuna = InputBox("Digite a coluna desejada ou cancela para sair", "Linha código para deletar", vColunaAtiva)

On Error Resume Next
Set vRange = Columns(vProcuraColuna)
On Error GoTo 0

'Se um intervalo inválido for inserido em seguida, sair
If vRange Is Nothing Then Exit Sub

vProcuraTexto = InputBox("Entre com o texto procurado", "Deleta código linha", [E1].Value) 'ActiveCell.Value)
If vProcuraTexto = "" Then
CheckaNulo = InputBox("Você realmente deseja excluir linhas com células vazias?" & vbNewLine & vbNewLine & _
"Sim quero, caso contrário sairá código", "Cuidado", "Não")
If CheckaNulo <> "Sim" Then Exit Sub
End If

Application.ScreenUpdating = False

'para coincidir com a seqüência de texto TODO
Set vColuna = vRange.Find(What:=vProcuraTexto, After:=vRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
'para corresponder a uma cadeia de texto PARCIAL use esta linha
'Set vColuna = vRange.Find(What:=vProcuraTexto, After:=vRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)
'para coincidir com o caso e de uma cadeia de texto TODO
'Set vColuna = vRange.Find(What:=vProcuraTexto, After:=vRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)

If Not vColuna Is Nothing Then
Set DeletaRange = vColuna
PrimeiroEndereco = vColuna.Address
Do
Set vColuna = vRange.FindNext(vColuna)
Set DeletaRange = Union(DeletaRange, vColuna)
Loop While PrimeiroEndereco <> vColuna.Address
'nao deixe de ver nosso trabalho com 100 planilhas exemplos Loops (com todas as intruções Do/While/Loop/until/For Next/)
End If

'Se houver condição verdadeira exclua as linhas
sbx = MsgBox("As Linhas contendo a palavra [ " & [E1] & " ] serão deletadas!!!", vbYesNo + vbCritical, "CUIDADO - AÇÃO IRREVERSÍVEL!!")
If sbx = 6 Then
If Not DeletaRange Is Nothing Then DeletaRange.EntireRow.Delete
End If
'caso queira retirar a mensagem vbyesno.
' If Not DeletaRange Is Nothing Then DeletaRange.EntireRow.Delete

Application.ScreenUpdating = True

End Sub

Sub limpar_teste()
[a].Copy [b]
[b].Value = "LISTA"
MsgBox "dados copiados para teste com sucesso!!!", vbInformation, "Saberexcel - site das macros"
End Sub

Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.

Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

If Cells(vLin, "e") = Cells(2, "f") Then '//====' fazer a comparação coluna(e) e celula(f2)
Cells(vLin, "e").Offset(0, 1).Resize(1, 12).Copy [h2] '//====' selecionar area para copiar
Cells(vLin, "e").Offset(0, -1).Value = "u" '// para inserir o sinal na coluna(d)
Cells(vLin, "e").Offset(0, -1).Font.Name = "Wingdings 3" '//===='inserir o sinal na coluna(D)
z = Cells(vLin, "e")
Exit For '//======='ao encontar e copiar para celula(h2) saí do loop
End If
Next vLin

MsgBox "Linha [ " & vLin & " ] Letra [ " & UCase(z) & " ] filtrados com sucesso!" & vbCrLf & _
"- - - - - - - - - - - - - - - - - - - - - - -" & vbCrLf & _
"Escola Saberexcel VBA Estudos® " & vbCrLf & _
"Treinamentos com Macros, Fórmulase Funções ", vbInformation, "Escola Saberexcel VBA Estudos®"
[f1].Select
End Sub

'//======= colorir sétimo caracter da colun(f) em vermelho
Sub sbx_colorir_setimo_caracter_vermelho()
Dim i As Long
For Col = 6 To 19
For i = 1 To Cells(Rows.Count, "f").End(xlUp).Row
Cells(i, Col).Characters(Start:=7, Length:=1).Font.ColorIndex = 3
Next i
Next Col
Saber1.Shapes("ver").Visible = False
Saber1.Shapes("pre").Visible = True
End Sub

'//======= colorir sétimo caracter da colun(f) em vermelho
Sub sbx_colorir_setimo_caracter_preto()
Dim i As Long
For Col = 6 To 19
For i = 1 To Cells(Rows.Count, "f").End(xlUp).Row
Cells(i, Col).Characters(Start:=7, Length:=1).Font.ColorIndex = 1
Next i
Next Col
Saber1.Shapes("ver").Visible = True
Saber1.Shapes("pre").Visible = False
End Sub

Sub sbx_selecionar_f2()
[f2].Select
End Sub

Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.





 <<< Registre-se em nosso Site >>>

Saberexcel - o site das macros


Esta macro deleta valores e linhas onde determinados valores estão inseridos neste caso a palavra "Saber", observe que aqui também ensino como voce poderá copiar dados de uma outra planilha ou da mesma folha de planilha de forma bem simples, alias todo meu trabalho será voltado para tentar fazer um tipo de programação bem simples e de fácil entendimento.
veja as Planilhas exemplos COMO FAZER - Programação MS Excel VBA - Saberexcel.

Option Explicit

Sub Deletar_com_AutoFiltro()
Dim vDeletaValor As String
Dim vRange As Range
Dim vModoCalcular As Long

With Application
vModoCalcular = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'preencha o valor que voce deseja excluir
'Variavel vDeletaValor = "<>'Saber" 'inserir diferente<> deleta todas as palavras diferentes "Saber"
vDeletaValor = "Saber"

'Use a folha de planilha com o nome que desejar neste caso é direcionado para planilha ativa
With ActiveSheet

'primeiramente deverá remover o autofiltro
.AutoFilterMode = False

'aplicando o autofiltro e critérios para coluna(A)
.Range("A1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=vDeletaValor

With .AutoFilter.Range
On Error Resume Next
Set vRange = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not vRange Is Nothing Then vRange.EntireRow.Delete
End With

'Removendo autofiltro novamente
.AutoFilterMode = False
End With

With Application
.ScreenUpdating = True
.Calculation = vModoCalcular
End With
[D6].Value = "Todas as linhas com as palavras [Saber] foram deletas......"
End Sub

Essa macro é um jeito simples de copiar alguma que ensino nas planilhas dos módulos como fazer - Programação MS Excel VBA
observe como fica bem mais simples e funciona com uma performance muito maior.

Sub copiar_teste()
Saber2.[A1:A105].Copy Saber1.[A1] 'busca os dados pelo nome da folha de código.
[D6].Value = "Todos os dados foram copiados para o teste!"
End Sub





Aprenda tudo sobre o Aplicativo Microsoft Excel VBA, sozinho, praticando com os produtos didáticos Saberexcel

Saberexcel - o site de quem precisa aprender Macros Microsoft Excel VBA

Esse macro do Aplicativo Microsoft Excel VBA, seleciona linhas e colunas pre-determinadas pelas variáveis em um macro. Também copiará os dados selecionados para Plan2, e G29, --- apenas para lhes para aprendermos como fazer uma forma simples - copiar e colar.

Sub selecionar_celulas()
'seleciona 6 seis linhas
'seleciona colunas até a 15ª Coluna + 4
'começa a selecionar a partir da coluna( 4+ 2) = (4 + i)
'variável (i) determinará a posição de linhas e colunas (+)
k = 1
i = 2

With Sheets("Selecionando_dados_variaveis")
.Range(.Cells(6, 4 + i), .Cells(k, 15 + i)).Select
End With

End Sub

Sub copiar_se_selecao_for_maior_uma_celula()
Dim Resposta As String

If Selection.Count = 1 Then 'caso contiver somente uma célula selecionada, poderia ser outra quantidade.
MsgBox ("nao há seleção para ser copiada"), vbInformation, "Saberexcel - execute o macro"
selecionar_celulas
Resposta = MsgBox("Deseja copiar a seleção para planilha [Plan2 e G17]", vbYesNo + vbInformation, "Saberexcel")

If Resposta = 6 Then ' 6 é igual a vbyes
Selection.Copy Saber2.[A1]
Selection.Copy [G29]
MsgBox ("Seleção copiada para Planilha 'Auxiliar'e Célula[G29]"), vbInformation, "Saberexcel - site das macros"
Else
[C1].Select
End If

Else
'copia os dados se caso já o macro 'Selecionar_Celulas' for acionado primeiramente na folha de planilha.
Selection.Copy Saber2.[A1]
Selection.Copy [G29] 'será copiado também os dados para mesma folha de planilha para célula G29
MsgBox ("Seleção copiada para Planilha 'Auxiliar'e Célula[G29]"), vbInformation, "Saberexcel - site das macros"
End If
End Sub

Sub limpar_teste()
Saber2.Cells.ClearContents
'esta linha abaixo vai limpar da célula G29 abaixo,
'Esses estudos de deslocar linhas e colunhas estão em nosso Modulo COMO FAZER - Programação MS Excel (Offset-Desloc)
Range("G29", [G29].End(xlDown).End(xlToRight)).ClearContents 'limpa dados G29 em diante, poderia ser select ou outra programação qualquer
MsgBox ("Os dados da folha de planilha 'Plan2' e G9 em diante foram deletada"), vbInformation, "Saberexcel - site das Macros"
End Sub

Sub ir_plan2()
Saber2.Select 'observe que sempre seleciono a folha de planiha pelo nome da folha de código,
'se o usuário mudar o nome da folha de planilha não ocorrerá erro.
End Sub

Sub voltar()
Saber1.Select
End Sub

Esse macro(código) é para auxiliar no teste, e também com finalidade didática, para mostrar o shapes(autoforma) contendo macro, ou se desejar
poderá mostrar diretamente a o Módulo VBE(Visual Basic Editor)
Sub visualizar_macros_vbe()
Dim Resposta As String

Resposta = MsgBox("Deseja visualizar as macros no módulo VBE?", vbYesNo, "Saberexcel - o site das macros")
If Resposta = 6 Then ' 6 é igual a vbyes
Application.Goto reference:="selecionar_celulas"
Else
Saber1.Shapes("sb").Visible = True
End If

End Sub

esse macro é para ocultar o shapes(autoforma)
Sub oc()
Saber1.Shapes("sb").Visible = False
End Sub



Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel




Publicidade
Compre com segurança, garantia e ótimos preços

Esse macro do aplicativo Microsoft Excel VBA(visual Basic Application), localiza a última linha e próxima em branco em colunas representadas por meses, após a seleção do mês desejado na célula(B1), observem que usei o Evento_Change do Objeto Worksheet(Folha de Planilha), que é sensibilzado ao selecionar o mês. Espero que o exemplo sirva. Fique com Deus, Expedito Marcondes

Sub procurar_palavra()
[B1].Select
Cells.Find(What:=Range("B1").Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Select
ActiveCell.End(xlDown).Offset(1, 0).Select
End Sub

Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel