Este fórum está sendo desativado

[werlewow]

Boa Tarde a todos, estou tentando desenvolver um código onde o usuário seleciona na coluna A (ou qualquer outra) as linhas em que ele deseja deletar, e o seu nome, e ao executar a macro ele deleta toda a linha.
Na planilha em anexo esta tudo funcionando como deveria, ao clicar no botão, digite seu nome e depois selecione a célula A3, por exemplo, a macro ira excluir toda linha 3, além de add na outra planilha o nº do pedido excluído e o nome do usuário.

O problema ocorre se o usuário tenta selecionar mais de 1 valor, por exemplo, as células A3:A4, ai o código não funciona...Alguém pode me ajudar para que funcione?

Obrigado.

[werlewow]

Alguém?

[osvaldomp]

Código: Selecionar todos

Sub ExcluiLinhas()
 Dim r As Range
  For Each r In Selection
   Sheets("Planilha2").Cells(Rows.Count, 1).End(3)(2) = Application.UserName
   Sheets("Planilha2").Cells(Rows.Count, 2).End(3)(2) = r.Value
   r.Value = ""
  Next r
 Range("A2:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlBlanks).EntireRow.Delete
End Sub

Selecione quantos pedidos quiser na coluna A e rode o código.

[werlewow]

Obrigado! Não resolveu totalmente, mas adaptei o código e deu certinho... Vou por abaixo caso alguém precise.

Sub excluir()
ActiveSheet.Unprotect "123mudar"
Dim r As Range
Dim myRange As Range
'On Error GoTo finaliza
Set myRange = Application.InputBox(Prompt:= _
"Selecione na coluna de pedidos todas as linhas que deseja excluir!", _
Title:="Excluir Pedido", Type:=8)

If myRange.Column <> 2 Then
MsgBox "Selecione os dados da coluna de pedidos somente"
Exit Sub

Else
If myRange Is Nothing Then

GoTo finaliza
Else


myRange.Select
End If
End If
For Each r In Selection
Sheets("Planilha2").Cells(Rows.Count, 2).End(3)(2) = Application.UserName
Sheets("Planilha2").Cells(Rows.Count, 1).End(3)(2) = r.Value
Sheets("Planilha2").Cells(Rows.Count, 3).End(3)(2) = Now()
r.Value = ""
Next r

Range("b5:b" & Cells(Rows.Count, 2).End(3).Row).SpecialCells(xlBlanks).EntireRow.Select

Selection.Delete Shift:=xlUp


MsgBox "Seu pedido foi excluido com sucesso"

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, Password:="123mudar"
Exit Sub

finaliza:
MsgBox "Operação cancelada"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, Password:="123mudar"
Exit Sub

End Sub