Este fórum está sendo desativado

[nmareis]

Boa tarde pessoal...tenho esta macro

Código: Selecionar todos

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

Workbooks.Open ("C:\Users\nelso\Desktop\excell\Preencher_Prod_Ramais\Guru\Livro 1.xlsx")
Workbooks.Open ("C:\Users\nelso\Desktop\excell\Preencher_Prod_Ramais\Guru\Livro 2.xlsx")
Workbooks.Open ("C:\Users\nelso\Desktop\excell\Preencher_Prod_Ramais\Guru\Livro 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

como podem verificar ela procura o ficheiro "LivroFinal"...no entanto este ficheiro poderá estar sempre a mudar de nome e aí tb tenho que mudar o nome na macro....existe alguma forma de a macro encontrar sempre o ficheiro independentemente do seu nome....esse ficheiro que falo é o único que acaba em formato .xlsm( não sei se ajuda ).

[alexandrevba]

Boa noite!!

Eu não entendi, mas caso o arquivo onde está a macro mude o nome (eu não sei por que isso seria necessário), use uma célula de uma guia qualquer para escrever nela o no me do arquivo.

Código: Selecionar todos

Sub Filtrar()
Application.ScreenUpdating = False
Dim Sdata As Date
'######## AleVBA #########################################################################
Dim varCellvalue As Long

varCellvalue = Worksheets("Plan1").Range("A1").Value 'Use uma célula de uma guia qualquer, nela insira o nome do seu arquivo

Workbooks.Open ("C:\Users\nelso\Desktop\excell\Preencher_Prod_Ramais\Guru\" & varCellvalue & ".xlsx")
'######## AleVBA #########################################################################

Workbooks.Open ("C:\Users\nelso\Desktop\excell\Preencher_Prod_Ramais\Guru\Livro 2.xlsx")
Workbooks.Open ("C:\Users\nelso\Desktop\excell\Preencher_Prod_Ramais\Guru\Livro 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

Att

[nmareis]

bem vou ver se me explico melhor...
o arquivo é uma produçaõ que tenho que enviar diáriamente....portanto o ficheiro vai-se chamar produção diária_11032017...para o dia seguinte vai se chamar produção diária_12032017...já percebeu?...daí a macro quando procura pelo nome como ele vai estar sempre a mudar não o encontra...

[nmareis]

está resolvido...obrigado na mesma...coloco aqui o código

Código: Selecionar todos

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

WFinal = ActiveWorkbook.Name

Workbooks.Open ("C:\Users\nelso\Desktop\excell\Preencher_Prod_Ramais\Guru\Livro 1.xlsx")
Workbooks.Open ("C:\Users\nelso\Desktop\excell\Preencher_Prod_Ramais\Guru\Livro 2.xlsx")
Workbooks.Open ("C:\Users\nelso\Desktop\excell\Preencher_Prod_Ramais\Guru\Livro 3.xlsx")

Workbooks(WFinal).Activate

Sdata = InputBox("Insira sua data abaixo:")
    
Set LivroFinal = Workbooks(WFinal).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