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