Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Tópicos relacionados a códigos VBA, gravação de macros, etc.
  • Avatar do usuário
#29686
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!
Você não está autorizado a ver ou baixar esse anexo.
#29732
Bom dia!!

Talvez isso ajude a ter uma ideia...
Código: Selecionar todos
Sub 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
#29742
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 todos
Sub 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
#29752
Boa tarde!

Segue...
Código: Selecionar todos
Sub 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
long long title how many chars? lets see 123 ok more? yes 60

We have created lots of YouTube videos just so you can achieve [...]

Another post test yes yes yes or no, maybe ni? :-/

The best flat phpBB theme around. Period. Fine craftmanship and [...]

Do you need a super MOD? Well here it is. chew on this

All you need is right here. Content tag, SEO, listing, Pizza and spaghetti [...]

Lasagna on me this time ok? I got plenty of cash

this should be fantastic. but what about links,images, bbcodes etc etc? [...]

Estamos migrando para uma comunidade no Discord