Este fórum está sendo desativado

[RodrigoP]

Bom Dia

Preciso de ajuda referente a uma macro

hoje tenho uma macro que copia uma aba de um arquivo do Excel e salva em uma pasta na rede, o problema que eu quero que ela salve apenas os valores sem formular sem macros, aguem pode me ajudar?

segue a macro que utilizo :

Sub Gerar_Aba()

Dim WPed As Worksheet
Dim W As Workbook
Dim Arq As String


Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set WPed = Sheets("Comercial")


WPed.Copy
Nome = "Disponibilidade Venda - " & Cells(1, 6)


'Salva o arquivo na pasta

ChDir "\\192.168.8.209\Usuarios\david\1Fio\Produção\Disponibilidade\"

ActiveWorkbook.SaveAs _
Filename:="\\192.168.8.209\Usuarios\david\1Fio\Produção\Disponibilidade\" _
& Nome & ".xlsx"
ActiveWorkbook.Close

MsgBox " Salvo com Sucesso"


Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

[fcarlosc2018]

Boa-tarde

Tente assim:

Código: Selecionar todos

Sub Gerar_Aba()

On Error GoTo Erro:

Dim CurrentSheet As Worksheet
Dim LocRede As String

LocRede = "\\192.168.8.209\Usuarios\david\1Fio\Produção\Disponibilidade\"

Sheets("Comercial").Activate

Application.ScreenUpdating = False

        'Nome na Planilha Ativa
        nomeB2 = "Disponibilidade Venda - " & Cells(1, 6)

        Set CurrentSheet = ActiveSheet

        On Error Resume Next

        'copia todas as células da planilha ativa
        CurrentSheet.Cells.Copy

        'Cria a Nova PASTA (ARQUIVO)
        Set Wkb = Workbooks.Add

        'cola somente os valores na planilha Ativa da nova Pasta,
        'sem formulas e mantendo a formatação
        With ActiveSheet.Range("A1")
          .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          .PasteSpecial Paste:=xlFormats
        End With

        Application.CutCopyMode = False

        'Define os Novos Nomes - Planilha(ABA) e Pasta(Arquivo)
        novoNome = nomeB2

        'Renomeia a planilha nova com
        'o Nome que estava em F1
        
        '--------With ActiveSheet
        '--------    .Name = novoNome
        '--------    .Range("F1").Select
        '--------End With

        Range("A1").Select

        'Enibe a mensagem se a pasta já existir
        'Com essa instrução a Pasta será substiutida sem questionamento
        Application.DisplayAlerts = False        
        
        Wkb.SaveAs Filename:=LocRede & "\" & novoNome & ".xlsx"
        
MsgBox ("Planilha salva com sucesso...!"), vbInformation, "Atenção!"
        
Erro:
MsgBox "Obs: Salve o Sistema para que não ocorra perda de Dados na Planilha" & Err.Description & _
vbclrf
        
Application.Visible = True
        
End Sub

[osvaldomp]

Acrescente a linha em vermelho conforme indicado abaixo.

WPed.Copy
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
Nome = "Disponibilidade Venda - " & Cells(1, 6)

[RodrigoP]

boa tarde

deu certo obrigado pela ajuda.

att