Remova as linhas com base no valor da célula com código VBA

[Cristiano Vidal]

Bom dia!

BONFÁ	02	10	12	26	51	56	67	69	73	77
CAPITÃO AMÉRICA	05	11	14	19	37	53	61	73	85	88
CARLIM	01	12	23	33	38	44	49	55	60	83
CARLINHO	01	05	11	12	13	16	17	20	21	27
CESAR OLEGARIO	11	33	46	59	65	69	73	75	79	93
CLAUDIO PA	01	04	08	13	17	25	30	92	99	00
CRIS BH	07	10	12	15	18	31	33	36	85	96
DAMIÃO	08	26	44	58	60	64	66	81	82	91
DIA DE SORTE	12	16	21	27	28	42	65	67	78	88
DIRCE	05	33	45	59	64	65	69	70	71	95
DR MARCOS	03	09	28	34	37	43	54	69	74	88
EDENILSOM	04	16	28	38	43	59	84	93	94	99

acima é como são minhas linhas, eu queria q o VBA selecionasse da coluna H (nome) até coluna R (último número da linha) mas com o código abaixo ele seleciona a linha inteira, é possivel adaptar esse código?

 

Sub DeleteRows()

'Updateby20211217

Dim rng As Range

Dim InputRng As Range

Dim DeleteRng As Range

Dim DeleteStr As String

Dim xTitleId As String

Dim xArr

Dim xF As Integer

Dim xWSh As Worksheet

On Error Resume Next

xTitleId = "Excluir apostas"

Set rng = Application.Selection

Set InputRng = Application.InputBox("Range :", xTitleId, rng.Address, Type:=8)

If InputRng Is Nothing Then Exit Sub

DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2)

Set xWSh = InputRng.Worksheet

For Each rng In InputRng

    If rng.Value = DeleteStr Then

        If DeleteRng Is Nothing Then

            Set DeleteRng = rng

        Else

            Set DeleteRng = Application.Union(DeleteRng, rng)

            Set DeleteRng = DeleteRng.EntireRow

        End If

    End If

Next

xArr = Split(DeleteRng.AddressLocal, ",")

DeleteRng.Select

DeleteRng.Delete

For xF = UBound(xArr) To 0 Step -1

    Set DeleteRng = xWSh.Range(xArr(xF))

    DeleteRng.Delete

Next

End Sub

 

[Alyson Ronnan Martins]

Se você deseja adaptar o código para selecionar apenas as colunas H até R em vez da linha inteira, você pode ajustar a maneira como o intervalo é tratado. Aqui está a versão adaptada do seu código:

Sub DeleteRows()

    ' Update by 20211217

    Dim rng As Range
    Dim InputRng As Range
    Dim DeleteRng As Range
    Dim DeleteStr As String
    Dim xTitleId As String
    Dim xArr
    Dim xF As Integer
    Dim xWSh As Worksheet

    On Error Resume Next
    xTitleId = "Excluir apostas"

    Set rng = Application.Selection
    Set InputRng = Application.InputBox("Range :", xTitleId, rng.Address, Type:=8)

    If InputRng Is Nothing Then Exit Sub

    DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2)

    Set xWSh = InputRng.Worksheet

    For Each rng In InputRng
        ' Verifica se a célula contém o texto a ser excluído
        If rng.Value = DeleteStr Then
            ' Se DeleteRng ainda não foi definido, define-o como a célula atual
            If DeleteRng Is Nothing Then
                Set DeleteRng = rng.Offset(0, 7).Resize(, 10) ' Ajusta para selecionar da coluna H até R
            Else
                ' Caso contrário, une DeleteRng com a nova célula
                Set DeleteRng = Application.Union(DeleteRng, rng.Offset(0, 7).Resize(, 10))
            End If
        End If
    Next

    ' Exclui as células selecionadas
    If Not DeleteRng Is Nothing Then
        DeleteRng.Delete
    End If

End Sub

As alterações foram feitas na linha:

Set DeleteRng = rng.Offset(0, 7).Resize(, 10)

Essa linha ajusta DeleteRng para começar da coluna H (Offset(0, 7)) e se estender até a coluna R (Resize(, 10)). Isso garante que somente as colunas desejadas sejam selecionadas para exclusão. Certifique-se de testar o código para garantir que ele atenda aos seus requisitos.

 

[Cristiano Vidal]

Bom dia, Alyson!

muito obrigado pela ajuda, mas não consegui adaptar seu código na minha planilha, posso te enviar uma cópia da minha planilha pra ver se consegue adaptar?