Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Filtrar por data e ...
 
Notifications
Clear all

Filtrar por data e copiar a informação filtrada

 
Página 2 / 2
2024 - VBA & Macros
Post Recente por nmareis 8 anos atrás
16 Posts
3 Usuários
0 Reactions
3,996 Visualizações
RSS
 nmareis
(@nmareis)
Posts: 22
Eminent Member
Topic starter
 

Boa noite pessoal,

tenho este código:

Sub Macro1()
'
' Macro1 Macro
'

'
    Windows("Livro 3.xlsx").Activate
    ActiveSheet.Range("$B$1:$R$6").AutoFilter Field:=13, Operator:= _
        xlFilterValues, Criteria2:=Array(2, "3/1/2017")
    Windows("Livro 2.xlsx").Activate
    Range("L17").Select
    ActiveSheet.Range("$B$1:$R$6").AutoFilter Field:=13, Operator:= _
        xlFilterValues, Criteria2:=Array(2, "3/1/2017")
    Windows("Livro 1.xlsx").Activate
    ActiveSheet.Range("$B$1:$R$12").AutoFilter Field:=13, Operator:= _
        xlFilterValues, Criteria2:=Array(2, "3/1/2017")
    Range("H20").Select
    Windows("Livro Final.xlsm").Activate
End Sub

e pretendo colocar nele uma uma InputBox

Dim sData As String 

sData = InputBox("Digite sua data")

isto com o objetivo de apenas colocar a data uma só vez e em todos os ficheiros acontece o filtro por data automáticamente.

alguém me pode ajudar ?

 
Postado : 04/03/2017 6:07 pm
 nmareis
(@nmareis)
Posts: 22
Eminent Member
Topic starter
 

JPedro

Está explicadissimo colega...obrigadão..era isto mesmo...já me poupaste alguns minutos de trabalho por dia..lol...abc

colega muito obrigado, mas agora estou aqui com uma questão...na macro tem o nome do ficheiro..livroFinal, contudo este nome vai estar sempre a mudar...não dá para arranjar forma de a macro detetar o ficheiro mesmo que este mude de nome?..obrigado...a macro é este..fiz uns ajustes para as minhas necessidades.

Sub Filtrar()
Application.ScreenUpdating = False
Dim Sdata As Date

Workbooks.Open ("C:UsersnelsoDesktopexcellPreencher_Prod_RamaisGuruLivro 1.xlsx")
Workbooks.Open ("C:UsersnelsoDesktopexcellPreencher_Prod_RamaisGuruLivro 2.xlsx")
Workbooks.Open ("C:UsersnelsoDesktopexcellPreencher_Prod_RamaisGuruLivro 3.xlsx")

Workbooks("LivroFinal.xlsm").Activate

Sdata = InputBox("Insira sua data abaixo:")
    
Set LivroFinal = Workbooks("LivroFinal.xlsm").Sheets("Produção Diária")
LivroFinal.Range("Q4") = Sdata

For x = 1 To 3

If x = 1 Then r = 12
If x = 2 Then r = 6
If x = 3 Then r = 6

Set Livro = Workbooks("Livro " & x & ".xlsx").Sheets("Ficheiro Ramais a Executar")
Livro.Range("B1:R" & r).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=LivroFinal.Range("Q3:Q4"), _
        CopyToRange:=LivroFinal.Range("B10000").End(xlUp).Offset(1, 0), _
        Unique:=False

Next x

For excluir = 39 To LivroFinal.Range("B10000").End(xlUp).Row
If Cells(excluir, 2) = "Expediente" Then
Rows(excluir).Delete Shift:=xlUp
End If
Next excluir

Workbooks("Livro 1.xlsx").Close SaveChanges:=False
Workbooks("Livro 2.xlsx").Close SaveChanges:=False
Workbooks("Livro 3.xlsx").Close SaveChanges:=False


End Sub
 
Postado : 11/03/2017 3:57 am
Página 2 / 2
Forum Jump:
  Tópico Anterior
Próximo Tópico