Este fórum está sendo desativado

[fsoares]

Olá galera, preciso de uma ajuda tenho um procedimento que utiliza o Filtro para selecionar alguns dados, depois que seleciona, copia a primeira célula e cola nas células abaixo (células que estão sendo visualizada na tela).
O problema é quando vai descer para a célula para abaixo, no procedimento está fixo e preciso que desça conforme a seleção do filtro, pois pode variar a próxima célula:
parte do meu código:
Range("A2").Select
ActiveSheet.Range("$A:$K").AutoFilter Field:=2, Criteria1:="<>", Operator _
:=xlAnd
ActiveSheet.Range("$A:$K").AutoFilter Field:=4, Criteria1:="="
Range("A2").Select
Selection.Copy
Range("A34").Select ' célula por variar dependo da quantidade de linhas que tem a planilha, uma hora pode cair em outra célula
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste

Na planilha de exemplo filtrei na coluna C "Descrição" e vou copiar A2 e colar na próxima abaixo neste caso é a A36 até a ultima que é A5556 conforme mostra o filtro, sendo que tenho outros arquivos que ao filtrar na coluna C "Descrição" a próxima linha abaixo pode ser qualquer outra linha.

[alexandrevba]

Bom dia!!

Tente algo assim

Código: Selecionar todos

Sub TheSpreadsheetGuru()
'FOnte: www.TheSpreadsheetGuru.com
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

  fnd = "Descricao"

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  Else
    GoTo NothingFound
  End If

Set rng = FoundCell
  Do Until FoundCell Is Nothing
      Set FoundCell = myRange.FindNext(after:=FoundCell)
      Set rng = Union(rng, FoundCell)
      If FoundCell.Address = FirstFound Then Exit Do
  Loop
  rng.Offset(0, -2).Value = "Código"
Exit Sub
NothingFound:
  MsgBox "Valor não encontrado"

End Sub

Att