Notifications
Clear all

VBA - Determinar planilha à ser usada de acordo com o mês

9 Posts
4 Usuários
0 Reactions
1,851 Visualizações
 CZa
(@cza)
Posts: 61
Trusted Member
Topic starter
 

Bom dia à todos.

Tenho uma pasta de trabalho para emissão de pedidos, a mesma é dividida em várias partes, das quais, três são as principais.
Um banco de dados, a própria de Solicitação de Compra, e os lançamentos dos pedidos feitos mês à mês.
Atualmente ela está dividida mais ou menos assim: Dez, Jan, Fev..., Banco de Dados, Solicitação de Compra.
Nessa pasta, consegui automatizar todo o processo de emissão dessa planilha, porém só estou precisando adaptar uma rotina nela.
Preciso adaptar uma rotina que determine a guia que irei usar de acordo com o mês vigente. Por exemplo: se estamos em fevereiro, ela irá lançar os dados que eu emitir na guia de Solicitação de Compra para a guia com o respectivo mês, no caso a guia "Fev"...

Alguém consegue me dar uma mãozinha?

Segue abaixo o código:

Sub lsItens()
    Application.ScreenUpdating = False
    Dim lUltimaLinhaAtiva As Long
    Dim lMax As Long
    Dim lLinhaAtual As Long
    Dim i As Integer
    Dim lItens As Integer
    
    lUltimaLinhaAtiva = Worksheets("FEV 14").Cells(Worksheets("FEV 14").Rows.Count, 2).End(xlUp).Row
    lLinhaAtual = lUltimaLinhaAtiva + 1
    Worksheets("Solicitação Compra Emax").Range("CQ16").FormulaLocal = "=MÁXIMO(" & "B10:B19" & ")"
    lItens = Range("CQ16").Value
    Worksheets("Solicitação Compra Emax").Range("CQ16").Clear
    
    lLinhaAtual = lLinhaAtual - 1
    
    For i = 1 To lItens
        Worksheets("FEV 14").Cells(lLinhaAtual + i, 2).Value = Sheets("Solicitação Compra Emax").Range("F5").Value 'data
        Worksheets("FEV 14").Cells(lLinhaAtual + i, 3).Value = Sheets("Solicitação Compra Emax").Range("BF5").Value 'solici
        Worksheets("FEV 14").Cells(lLinhaAtual + i, 4).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 4).Value 'cod *
        Worksheets("FEV 14").Cells(lLinhaAtual + i, 5).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 12).Value 'desc*
        Worksheets("FEV 14").Cells(lLinhaAtual + i, 6).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 7).Value 'qtd*
        Worksheets("FEV 14").Cells(lLinhaAtual + i, 7).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 10).Value 'uni*
        Worksheets("FEV 14").Cells(lLinhaAtual + i, 8).Value = Sheets("Solicitação Compra Emax").Range("L1").Value 'solicitante
        Worksheets("FEV 14").Cells(lLinhaAtual + i, 9).Value = Sheets("Solicitação Compra Emax").Range("AP10").Value 'aplicação
        Worksheets("FEV 14").Cells(lLinhaAtual + i, 10).Value = Sheets("Solicitação Compra Emax").Range("BO31").Value 'cc
        Worksheets("FEV 14").Cells(lLinhaAtual + i, 11).Value = Sheets("Solicitação Compra Emax").Range("F5").Value 'entrada compras
    Next i
    
    'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    
    Range("BI24:BR24").Select
    ActiveCell.FormulaR1C1 = "=R[-23]C[-49]"
    
    Const cstrRoot As String = "\192.168.0.250AlmoxarifadoNovoAlmoxarifadoSolicitacao de CompraSolicitação de Compra Eletrônica"
    
    Dim lngYear As Long
    Dim strMonth As String
    Dim nameFile As String
    
    lngYear = Year(Date)
    strMonth = StrConv(Format(Date, "MMMM"), vbProperCase)
    nameFile = Range("BF5").Value & ".pdf"
    
    On Error Resume Next
    MkDir cstrRoot & lngYear
    MkDir cstrRoot & lngYear & "" & strMonth
    On Error GoTo 0
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "\192.168.0.250AlmoxarifadoNovoAlmoxarifadoSolicitacao de CompraSolicitação de Compra Eletrônica" & lngYear & "" & strMonth & "" & nameFile, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    True
    
    Sheets("Solicitação Compra Emax").Select
    Range("BI24:BR24").Select
    Selection.ClearContents
    Range("D10:F19").Select
    Selection.ClearContents
    Range("D10:F10").Select
    [BF5] = [BF5] + 1
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
    
End Sub
 
Postado : 04/02/2014 4:52 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Na minha opinião faltou alguns detalhes, tipo, esta rotina está associada a algum botão na planilha, em que range é digitado o Mes, entre outros.
Então supondo que em sua aba Solicitação de Compra o Mes esteja no Range("E3") com validação com os nomes dos meses, e apos selecionar o Mes e preencher toda a proposta você acionara um Botão para lançar, e supondo que os endereços nesta rotina são iguais para todos os meses, só precisamos criar uma Variavel para captar o mes e ajustar na rotina, exemplificando, em sua rotina apos a linha Dim lItens As Integer o adicione :

Supondo que o Mess está no Range("E3")
Dim swMes As Worksheet

Set swMes = Worksheets(Range("E3").Value)

Depois troque nesta rotina todas as referencias direta a aba "FEV 14" pela Variável swMes.

Se quiser fazer um teste antes de adaptar toda a rotina, utilize a rotina abaixo :
Coloque o nome do mes em "E3" e associe a rotina a um botão.

Sub GravaMes()

    Dim swMes As Worksheet
    
    Set swMes = Worksheets(Range("E3").Value)
    
    swMes.Activate

End Sub

Editei o post só para mostrar como ajustar as linhas, se não poderá ter erros, ou seja a linha abaixo:

lUltimaLinhaAtiva = Worksheets("FEV 14").Cells(Worksheets("FEV 14").Rows.Count, 2).End(xlUp).Row

Ficará assim :
lUltimaLinhaAtiva = swMes.Cells(swMes.Rows.Count, 2).End(xlUp).Row

Seguindo esta composição é só ajustar as demais.

Espero que seja isto,

[]s

 
Postado : 04/02/2014 5:43 am
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

CZa,

Segue outra sugestão:

    Sub lsItens()
        Application.ScreenUpdating = False
        Dim lUltimaLinhaAtiva As Long
        Dim lMax As Long
        Dim lLinhaAtual As Long
        Dim i As Integer
        Dim lItens As Integer
        Dim NomePlan as String
        Dim Wks as WorkSheet

    For Each wks In Worksheets
        Select Case Month(Date)
        Case 1
              NomePlan = "JAN " & Right(Year(Date), 2)
              Exit For
        Case 2
              NomePlan = "FEV " & Right(Year(Date), 2)
              Exit For
        Case 3
              NomePlan = "MAR " & Right(Year(Date), 2)
              Exit For
        Case 4
              NomePlan = "ABR " & Right(Year(Date), 2)
              Exit For
        Case 5
              NomePlan = "MAI " & Right(Year(Date), 2)
              Exit For
        Case 6
              NomePlan = "JUN " & Right(Year(Date), 2)
              Exit For
        Case 7
              NomePlan = "JUL " & Right(Year(Date), 2)
              Exit For
        Case 8
              NomePlan = "AGO " & Right(Year(Date), 2)
              Exit For
        Case 9
              NomePlan = "SET " & Right(Year(Date), 2)
              Exit For
        Case 10
              NomePlan = "OUT " & Right(Year(Date), 2)
              Exit For
        Case 11
              NomePlan = "NOV " & Right(Year(Date), 2)
              Exit For
        Case 12
              NomePlan = "DEZ " & Right(Year(Date), 2)
              Exit For
        End Select
    Next



       
        lUltimaLinhaAtiva = Worksheets(NomePlan).Cells(Worksheets("FEV 14").Rows.Count, 2).End(xlUp).Row
        lLinhaAtual = lUltimaLinhaAtiva + 1
        Worksheets("Solicitação Compra Emax").Range("CQ16").FormulaLocal = "=MÁXIMO(" & "B10:B19" & ")"
        lItens = Range("CQ16").Value
        Worksheets("Solicitação Compra Emax").Range("CQ16").Clear
       
        lLinhaAtual = lLinhaAtual - 1
       
        For i = 1 To lItens
                Worksheets(NomePlan).Cells(lLinhaAtual + i, 2).Value = Sheets("Solicitação Compra Emax").Range("F5").Value 'data
                Worksheets(NomePlan).Cells(lLinhaAtual + i, 3).Value = Sheets("Solicitação Compra Emax").Range("BF5").Value 'solici
                Worksheets(NomePlan).Cells(lLinhaAtual + i, 4).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 4).Value 'cod *
                Worksheets(NomePlan).Cells(lLinhaAtual + i, 5).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 12).Value 'desc*
                Worksheets(NomePlan).Cells(lLinhaAtual + i, 6).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 7).Value 'qtd*
                Worksheets(NomePlan).Cells(lLinhaAtual + i, 7).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 10).Value 'uni*
                Worksheets(NomePlan).Cells(lLinhaAtual + i, 8).Value = Sheets("Solicitação Compra Emax").Range("L1").Value 'solicitante
                Worksheets(NomePlan).Cells(lLinhaAtual + i, 9).Value = Sheets("Solicitação Compra Emax").Range("AP10").Value 'aplicação
                Worksheets(NomePlan).Cells(lLinhaAtual + i, 10).Value = Sheets("Solicitação Compra Emax").Range("BO31").Value 'cc
                Worksheets(NomePlan).Cells(lLinhaAtual + i, 11).Value = Sheets("Solicitação Compra Emax").Range("F5").Value 'entrada compras
        Next i
       
        'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
       
        Range("BI24:BR24").Select
        ActiveCell.FormulaR1C1 = "=R[-23]C[-49]"
       
        Const cstrRoot As String = "\192.168.0.250AlmoxarifadoNovoAlmoxarifadoSolicitacao de CompraSolicitação de Compra Eletrônica"
       
        Dim lngYear As Long
        Dim strMonth As String
        Dim nameFile As String
       
        lngYear = Year(Date)
        strMonth = StrConv(Format(Date, "MMMM"), vbProperCase)
        nameFile = Range("BF5").Value & ".pdf"
       
        On Error Resume Next
        MkDir cstrRoot & lngYear
        MkDir cstrRoot & lngYear & "" & strMonth
        On Error GoTo 0
       
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "\192.168.0.250AlmoxarifadoNovoAlmoxarifadoSolicitacao de CompraSolicitação de Compra Eletrônica" & lngYear & "" & strMonth & "" & nameFile, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
       
        Sheets("Solicitação Compra Emax").Select
        Range("BI24:BR24").Select
        Selection.ClearContents
        Range("D10:F19").Select
        Selection.ClearContents
        Range("D10:F10").Select
        [BF5] = [BF5] + 1
        ActiveWorkbook.Save
        Application.ScreenUpdating = True
       
    End Sub
 
Postado : 04/02/2014 6:19 am
(@gtsalikis)
Posts: 2373
Noble Member
 

Como o pessoal já respondeu, apenas uma outra sugestão:

Dim MesAno As String

MesAno = Left(UCase(MonthName(Month(Date))), 3) & " " & Right(Year(Date), 2)

Incluí no código

Sub lsItens()
    Application.ScreenUpdating = False
    Dim lUltimaLinhaAtiva As Long
    Dim lMax As Long
    Dim lLinhaAtual As Long
    Dim i As Integer
    Dim lItens As Integer
    Dim MesAno As String
    
    MesAno = Left(UCase(MonthName(Month(Date))), 3) & " " & Right(Year(Date), 2)
    
    lUltimaLinhaAtiva = Worksheets(MesAno).Cells(Worksheets(wsMesAno).Rows.Count, 2).End(xlUp).Row
    lLinhaAtual = lUltimaLinhaAtiva + 1
    Worksheets("Solicitação Compra Emax").Range("CQ16").FormulaLocal = "=MÁXIMO(" & "B10:B19" & ")"
    lItens = Range("CQ16").Value
    Worksheets("Solicitação Compra Emax").Range("CQ16").Clear
    
    lLinhaAtual = lLinhaAtual - 1
    
    For i = 1 To lItens
        Worksheets(MesAno).Cells(lLinhaAtual + i, 2).Value = Sheets("Solicitação Compra Emax").Range("F5").Value 'data
        Worksheets(MesAno).Cells(lLinhaAtual + i, 3).Value = Sheets("Solicitação Compra Emax").Range("BF5").Value 'solici
        Worksheets(MesAno).Cells(lLinhaAtual + i, 4).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 4).Value 'cod *
        Worksheets(MesAno).Cells(lLinhaAtual + i, 5).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 12).Value 'desc*
        Worksheets(MesAno).Cells(lLinhaAtual + i, 6).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 7).Value 'qtd*
        Worksheets(MesAno).Cells(lLinhaAtual + i, 7).Value = Sheets("Solicitação Compra Emax").Cells(9 + i, 10).Value 'uni*
        Worksheets(MesAno).Cells(lLinhaAtual + i, 8).Value = Sheets("Solicitação Compra Emax").Range("L1").Value 'solicitante
        Worksheets(MesAno).Cells(lLinhaAtual + i, 9).Value = Sheets("Solicitação Compra Emax").Range("AP10").Value 'aplicação
        Worksheets(MesAno).Cells(lLinhaAtual + i, 10).Value = Sheets("Solicitação Compra Emax").Range("BO31").Value 'cc
        Worksheets(MesAno).Cells(lLinhaAtual + i, 11).Value = Sheets("Solicitação Compra Emax").Range("F5").Value 'entrada compras
    Next i
    
    'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    
    Range("BI24:BR24").Select
    ActiveCell.FormulaR1C1 = "=R[-23]C[-49]"
    
    Const cstrRoot As String = "\192.168.0.250AlmoxarifadoNovoAlmoxarifadoSolicitacao de CompraSolicitação de Compra Eletrônica"
    
    Dim lngYear As Long
    Dim strMonth As String
    Dim nameFile As String
    
    lngYear = Year(Date)
    strMonth = StrConv(Format(Date, "MMMM"), vbProperCase)
    nameFile = Range("BF5").Value & ".pdf"
    
    On Error Resume Next
    MkDir cstrRoot & lngYear
    MkDir cstrRoot & lngYear & "" & strMonth
    On Error GoTo 0
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "\192.168.0.250AlmoxarifadoNovoAlmoxarifadoSolicitacao de CompraSolicitação de Compra Eletrônica" & lngYear & "" & strMonth & "" & nameFile, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    True
    
    Sheets("Solicitação Compra Emax").Select
    Range("BI24:BR24").Select
    Selection.ClearContents
    Range("D10:F19").Select
    Selection.ClearContents
    Range("D10:F10").Select
    [BF5] = [BF5] + 1
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
    
End Sub
 
Postado : 04/02/2014 10:30 am
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

Valeu, Gilmar!

Muito bem pensado.

 
Postado : 04/02/2014 1:30 pm
 CZa
(@cza)
Posts: 61
Trusted Member
Topic starter
 

Valeu pessoal, brigadão...

Utilizei a do Gilmar que estava mais enxuta e deu certo... Porém, não sei se você passou batido, mas só funcionou depois que tirei o ws da expressão
lUltimaLinhaAtiva = Worksheets(MesAno).Cells(Worksheets(wsMesAno).Rows.Count, 2).End(xlUp).Row

Só me desculpem aí por não postar a pasta, mas a política da empresa é bastante rígida quanto à exposição de dados da mesma... Enfim, é melhor evitar qualquer problema... :P

Mais uma última dúvida...

Existe alguma forma pra conseguir adaptar o comando Selection.FillDown para arrastar uma fórmula que tem na planilha "FEV 14" até o último item que foi lançado?
Todas as formas que consegui foi apenas para o próximo item, e pode ser que tenha que lançar 10 itens, apenas o primeiro teria a fórmula, como faço pra conseguir arrasta-la até o último item?

No mais obrigado mesmo...

 
Postado : 04/02/2014 6:31 pm
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

CZa,

Boa Noite!

Sempre é muito bom e proveitoso você compactar o arquivo e anexá-lo aqui pois assim fica mais fácil e produtivo. Você sabe que em programação os mínimos detalhes são importantes. Desse modo, em casos futuros, você deve descaracterizar dados confidenciais, como por exemplo, logotipo, nome de clientes, telefones, etc. e anexar um exemplo real do que precisa.

Quanto a sua última dúvida colocada, é possível utilizar um código para colocar as fórmulas em todas as linhas que você quiser. Como disse, para isso, é importante saber um monte de detalhes sobre a planilha real. Mas... supondo que sua fórmula esteja na coluna D, linha 5, da aba chamada Plan1 e que essa fórmula seja a multiplicação do valor contido na célula da coluna B pelo valor contido na célula C e que você queira copiar a fórmula = B5*C5 que está na célula D5, da linha 6 até a linha 15, você poderia fazer assim:

For i = 6 to 15
     Range("D" & i).FormulaLocal = "=B" & i & "*C" & i
Next
 
Postado : 04/02/2014 8:23 pm
 CZa
(@cza)
Posts: 61
Trusted Member
Topic starter
 

Bom dia, Wagner.

Obrigado pelo feedback. Enxuguei a pasta e retirei o que seria os dados da empresa. Segue anexo.

Quanto às fórmulas, agora com a pasta dá pra você ter uma noção melhor...
Da forma que você propôs, limita da linha 6 à linha 15, porém não é bem assim. O que queria era que arrastasse a fórmula até a última linha que lancei no dashboard "FEV 14", por exemplo. Isso seria de 1 à 10 linhas, que é o máximo que posso lançar por solicitação.

Na plan FEV 14, são duas fórmulas. Uma com a data do dia (Coluna L) =HOJE() (L6:...) e uma subtração DIAS EM ATRASO (Coluna M), =L6-K6, =L7-K7, =L7-K7 e assim por diante.

Conforme lançar os pedidos, o código arrastará essas duas fórmulas até a última que lancei, que conforme disse anteriormente, pode ser de 1 à 10 linhas...

*Só explicando, a função que vocês me ajudaram anteriormente é chamada pelo botão "Gerar Pedido" na guia "Solicitação Compra Emax".

Desde já, grato.

 
Postado : 05/02/2014 4:34 am
(@wagner-morel-vidal-nobre)
Posts: 4063
Famed Member
 

CZa,

Bom Dia!

Não sei se entendi e fiz corretamente. Teste e dê retorno se é isso mesmo.

 
Postado : 21/05/2014 8:20 am