SALVAR NO DIRETORIO DE ORIGEM E COM NOME PERSONALIZADO
Enviado: 05 Fev 2021 às 11:21
Pessoal, dá uma força para resolver esse problema
Eu fiz o código abaixo para copiar os dados/formato do arquivo "Pricing_Corporativo - Prop2021-xxxx-v1_Customer" e criar um novo arquivo para colar os dados/formato. Beleza! eu consegui fazer isso, porém, eu preciso que o novo arquivo seja salvo com o nome da seguinte forma "LPU_(data Windows)_prop2021-xxxx-v1_Customer" e que esteja no diretório do arquivo de origem (Pricing_Corporativo[...]_Customer), mas é neste que estou me perdendo, pois o novo arquivo perde a referência do diretório. Anexei a imagem da etapa que quero eliminar, ou seja, quero que seja feito automaticamente.
Obs.: onde esta "xxxx" é alterado para número conforme cada usuário utiliza o arquivo, assim como o "Customer" é alterado para o nome do cliente em questão.
Abaixo o código e onde esta grifado o paliativo que estou usando atualmente, mas que desejo deixar "automatizado"
Option Explicit
Sub btExecuta_Click()
Dim WP As Workbook 'Pasta de trabalho atual
Dim WS As New Workbook 'Nova Pasta de Trabalho
Dim WPSheet As Worksheet 'Planilha Atual
Dim rngWp As Range 'Região com dados da plan atual
Dim X As Byte
Dim Y As Long
Dim Z As Integer
Set WP = ActiveWorkbook
Set WPSheet = WP.Sheets("Pricing")
Range(Cells(5, 5), Cells(2000, 31)).Copy 'Copia todas as celulas utilizadas. VERIFICAR COMO DELIMITAR A REGIÃO A SER COPIADA
Set WS = Workbooks.Add 'Adiciona uma nova workbook
WS.Sheets(1).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues 'Cola os valores
ActiveCell.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone 'Cola o formato
Range(Cells(1, 1), Cells(4, 6)).Clear 'Limpa os dados referente à margem
Range(Cells(1, 5), Cells(2000, 5)).Delete 'Deleta os dados referente ao PV unit sem impostos
Range(Cells(1, 6), Cells(2000, 6)).Delete 'Deleta os dados referente ao PV unit sem impostos
WS.Sheets(1).Name = WPSheet.Name
ActiveWindow.DisplayGridlines = False 'Retira as linhas de grade
Worksheets("Pricing").Range("A1:X2000").Columns.AutoFit
Worksheets("Pricing").Range("A1").Select
Application.DisplayAlerts = False
ThisWorkbook.SaveAs 'indica a pasta para salvar e é necessário digitar o nome
WS.Close savechanges:=True
Application.DisplayAlerts = True
WP.Activate
WP.Sheets(33).Select
WPSheet.Range("G7").Select
MsgBox "Anexo Salvo", vbOKOnly
End Sub
Eu fiz o código abaixo para copiar os dados/formato do arquivo "Pricing_Corporativo - Prop2021-xxxx-v1_Customer" e criar um novo arquivo para colar os dados/formato. Beleza! eu consegui fazer isso, porém, eu preciso que o novo arquivo seja salvo com o nome da seguinte forma "LPU_(data Windows)_prop2021-xxxx-v1_Customer" e que esteja no diretório do arquivo de origem (Pricing_Corporativo[...]_Customer), mas é neste que estou me perdendo, pois o novo arquivo perde a referência do diretório. Anexei a imagem da etapa que quero eliminar, ou seja, quero que seja feito automaticamente.
Obs.: onde esta "xxxx" é alterado para número conforme cada usuário utiliza o arquivo, assim como o "Customer" é alterado para o nome do cliente em questão.
Abaixo o código e onde esta grifado o paliativo que estou usando atualmente, mas que desejo deixar "automatizado"
Option Explicit
Sub btExecuta_Click()
Dim WP As Workbook 'Pasta de trabalho atual
Dim WS As New Workbook 'Nova Pasta de Trabalho
Dim WPSheet As Worksheet 'Planilha Atual
Dim rngWp As Range 'Região com dados da plan atual
Dim X As Byte
Dim Y As Long
Dim Z As Integer
Set WP = ActiveWorkbook
Set WPSheet = WP.Sheets("Pricing")
Range(Cells(5, 5), Cells(2000, 31)).Copy 'Copia todas as celulas utilizadas. VERIFICAR COMO DELIMITAR A REGIÃO A SER COPIADA
Set WS = Workbooks.Add 'Adiciona uma nova workbook
WS.Sheets(1).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues 'Cola os valores
ActiveCell.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone 'Cola o formato
Range(Cells(1, 1), Cells(4, 6)).Clear 'Limpa os dados referente à margem
Range(Cells(1, 5), Cells(2000, 5)).Delete 'Deleta os dados referente ao PV unit sem impostos
Range(Cells(1, 6), Cells(2000, 6)).Delete 'Deleta os dados referente ao PV unit sem impostos
WS.Sheets(1).Name = WPSheet.Name
ActiveWindow.DisplayGridlines = False 'Retira as linhas de grade
Worksheets("Pricing").Range("A1:X2000").Columns.AutoFit
Worksheets("Pricing").Range("A1").Select
Application.DisplayAlerts = False
ThisWorkbook.SaveAs 'indica a pasta para salvar e é necessário digitar o nome
WS.Close savechanges:=True
Application.DisplayAlerts = True
WP.Activate
WP.Sheets(33).Select
WPSheet.Range("G7").Select
MsgBox "Anexo Salvo", vbOKOnly
End Sub