Página 1 de 1
Código de verificação de validade e criação de pasta
Enviado: 25 Jan 2018 às 07:09
por rit
Bom dia Amigos,
Estou anexando uma planilha e gostaria de saber se alguém consegue escrever um código que faça o seguinte:
Fazer uma verificação na coluna "data de entrega" e pegar tudo que seja das datas que ja passou até duas semanas para frente e faça outra verificação na coluna "nome abreviado" e me retorne uma opção para que eu escolha o fornecedor que esta na coluna "nome abreviado" para eu selecionar qual eu quero que ele liste essas linhas de duas semanas para frente em outro documento com o nome que eu selecionar> Exemplo aperto o botão ele faz a coleta dos dados com as datas que ja passou até duas semanas para frente e em seguida eu possa selecionar o fornecedor que eu quero que ele faça a lista, e gere outra pasta com o nome que eu escolher.
Obrigado!
Re: Código de verificação de validade e criação de pasta
Enviado: 26 Jan 2018 às 07:57
por alexandrevba
Bom dia!!
Talvez isso ajude a ter uma ideia...
Código: Selecionar todosSub AleVBA_6158()
Dim lr As Long
Dim sNomeAbreviado As String
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Worksheets("Planilha1")
[K1].Value = "InsForm"
.AutoFilterMode = False
.Range("K2").Formula = "=INT((TODAY()-I2)/7)"
.Range("K2").AutoFill Destination:=Range("K2:K" & lr)
.Range("A1:K1").AutoFilter
.Range("A1:K1").AutoFilter Field:=11, Criteria1:=">" & 2
sNomeAbreviado = InputBox("Selecione o Nome Abreviado")
.Range("A1:K1").AutoFilter Field:=5, Criteria1:=sNomeAbreviado
.Range("A2:J" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Worksheets("AleVBA").Range("A1")
'Favor criar uma guia com o nome AleVBA
End With
End Sub
Att
Código de verificação de validade e criação de pasta
Enviado: 26 Jan 2018 às 09:49
por rit
Oi ALe tudo bem ?
Cara deu muito bom, se eu quisesse agora que no final ele salva-se uma pasta ? com o nome que eu escolhi ? como eu faria isso ?
Re: Código de verificação de validade e criação de pasta
Enviado: 26 Jan 2018 às 10:38
por alexandrevba
Bom dia!!
Caso você deseja digitar o nome do arquivo em uma InputBox, siga a ideia que eu utilizei no código para filtrar (
Código: Selecionar todos sNomeAbreviado = InputBox("Selecione o Nome Abreviado")
)
Código: Selecionar todosSub AleVBA_6158()
'https://gurudoexcel.com/forum/viewtopic.php?f=12&t=6158
Dim lr As Long
Dim sNomeAbreviado As String
Dim wb As Workbook
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Worksheets("Planilha1")
[K1].Value = "InsForm"
.AutoFilterMode = False
.Range("K2").Formula = "=INT((TODAY()-I2)/7)"
.Range("K2").AutoFill Destination:=Range("K2:K" & lr)
.Range("A1:K1").AutoFilter
.Range("A1:K1").AutoFilter Field:=11, Criteria1:=">" & 2
sNomeAbreviado = InputBox("Selecione o Nome Abreviado")
.Range("A1:K1").AutoFilter Field:=5, Criteria1:=sNomeAbreviado
.Range("A2:J" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Worksheets("AleVBA").Range("A1")
Set wb = Workbooks.Add
ThisWorkbook.Sheets("AleVBA").Copy Before:=wb.Sheets(1)
wb.SaveAs "C:\temp\FileAleVBA.xlsx" '<- favor indicar o caminho onde pretende salvar o arquivo
End With
End Sub
Att
Re: Código de verificação de validade e criação de pasta
Enviado: 26 Jan 2018 às 10:48
por rit
cara nao consegui fazer funcionar nessa pasta de trablho, desculpa o incomodo mas pode dar uma olhada ?
Re: Código de verificação de validade e criação de pasta
Enviado: 26 Jan 2018 às 12:01
por alexandrevba
Boa tarde!
Segue...
Código: Selecionar todosSub teste_guru()
Dim lr As Long
Dim sNomeAbreviado As String
Dim wb As Workbook
lr = Cells(Rows.Count, "A").End(xlUp).Row
With Worksheets("ES0659")
.Range("AD:AD").Delete
[AD3].Value = "InsForm"
.AutoFilterMode = False
.Range("AD4").Formula = "=INT((TODAY()-S4)/7)" 'Qual é a coluna de data?
.Range("AD4").AutoFill Destination:=Range("AD4:AD" & lr)
.Range("D3:AD3").AutoFilter
.Range("D3:AD3").AutoFilter Field:=27, Criteria1:=">" & 2
sNomeAbreviado = InputBox("Selecione o Nome Abreviado")
If sNomeAbreviado = vbNullString Then
MsgBox ("Busca cancelada")
.AutoFilterMode = False
.Range("AD:AD").Delete
Exit Sub
End If
.Range("A3:AC3").AutoFilter Field:=12, Criteria1:=sNomeAbreviado
.Range("A3:AC" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Worksheets("ATRASO").Range("A1")
Set wb = Workbooks.Add
ThisWorkbook.Sheets("ATRASO").Copy Before:=wb.Sheets(1)
wb.SaveAs "C:\Users\Administrador\Downloads\FileAleVBA.xlsx" '<- favor indicar o caminho onde pretende salvar o arquivo
End With
End Sub
Att