Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Nova variavel em no...
 
Notifications
Clear all

Nova variavel em nova aba

 
2024 - VBA & Macros
Post Recente por JokerPot 10 anos atrás
7 Posts
2 Usuários
0 Reactions
1,270 Visualizações
RSS
 JokerPot
(@jokerpot)
Posts: 0
New Member
Topic starter
 

Boa Tarde!

Pessoal boa tarde!

Gostaria da ajuda de vcs. Fiz a macro abaixo a qual esta me ajudando, porem nao estou conseguindo solucionar um problema.
Se eu quiser incluir uma nova variavel de busca e colar em uma nova Sheets da planilha qual o codigo que tenho que incluir??

Sub gerar1()
lin = 2
linha = 2
Do Until Sheets("planilha").Cells(lin, 1) = ""
   If Sheets("planilha").Cells(lin, 1) = "DDDDDDD" Then
      Sheets("plan2").Cells(linha, 1) = Sheets("planilha").Cells(lin, 1)
      Sheets("plan2").Cells(linha, 2) = Sheets("planilha").Cells(lin, 2)
      Sheets("plan2").Cells(linha, 3) = Sheets("planilha").Cells(lin, 3)
      Sheets("plan2").Cells(linha, 4) = Sheets("planilha").Cells(lin, 4)
      Sheets("plan2").Cells(linha, 5) = Sheets("planilha").Cells(lin, 5)
      Sheets("plan2").Cells(linha, 6) = Sheets("planilha").Cells(lin, 6)
      linha = linha + 1
   End If
lin = lin + 1
Loop
End Sub

Deixei um exemplo tb em anexo. O arquivo original pode possuir mais de 15.000 linhas.

TesteGerar.zip
 
Postado : 21/07/2014 1:41 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Tente isso..

Sub AleVBA_12609()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Dim Rng As Range

Set Rng = Range([A1], Range("A" & Rows.Count).End(xlUp))

On Error Resume Next
    With Rng
        .AutoFilter , field:=1, Criteria1:="YYYYYYYYY"
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Plan3").Range("A1")
        .AutoFilter
    End With
    
    With Rng
        .AutoFilter , field:=1, Criteria1:="DDDDDDD"
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Plan2").Range("A1")
        .AutoFilter
    End With
    
On Error GoTo 0

Application.EnableEvents = True

End Sub

Att

 
Postado : 21/07/2014 4:24 pm
 JokerPot
(@jokerpot)
Posts: 0
New Member
Topic starter
 

Ola alexandrevba.

Funcionou perfeitamente.
Muito obrigado.
Só uma duvida: se eu quiser colocar mais criterios e mais Sheets é so eu ir incluindo mais linhas de codigo como esta sempre alterando o valor das linhas Criteria1: e em Sheets("Plan2")???

With Rng
        .AutoFilter , field:=1, Criteria1:="DDDDDDD"
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Plan2").Range("A1")
        .AutoFilter
    End With
 
Postado : 21/07/2014 5:10 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Sim!!

Mas há outras formas de se fazer isso!

Att

 
Postado : 21/07/2014 5:15 pm
 JokerPot
(@jokerpot)
Posts: 0
New Member
Topic starter
 

A sim, entendi.
Tenho bastante ID para pesquisar e irei fazer isso para cada ID e uma Sheets correspondente para cada uma.
Me disseram que da pra dar um nome para cada Sheets com o valor que estiver em uma celula.
Cara, sei que é um trabalho dificil mas se vc tiver um tempo vc pode me ajudar a fazer isso??? Dar um nome a cada Sheets conforme o valor do ID pesquisado e uma forma de se colocar varios IDs para buscar dentro do VBA em algumas poucas linhas de codigo???

Mas se nao der, tenha certeza de que voce ja me ajudou pacas e ja sou grato por isso.

 
Postado : 21/07/2014 5:33 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Na pesquisa encontrará tudo que precisa!

Essa postagem faz isso!
viewtopic.php?f=10&t=12588

Att

 
Postado : 21/07/2014 5:43 pm
 JokerPot
(@jokerpot)
Posts: 0
New Member
Topic starter
 

Dei uma verificada no post indicado, mas é melhor fazer na mao mesmo, vai na raça hehehe.
Tentei entender e localizar as partes que necessito, mas é muito dificil pra mim que nao entendo muito disso.
Obrigado pela ajuda.

 
Postado : 22/07/2014 7:34 am
Forum Jump:
  Tópico Anterior
Próximo Tópico