ola, boa noite segue codigo

Private Sub CommandButton3_Click()
Dim CurrentSheet2, CurrentSheet3 As Worksheet
Dim WKB2 As Workbook
Dim Nome2, NovoNome2 As String  ' Declara a variável como string ( texto)
Dim NomeAba2, NomeAba3 As String

Application.ScreenUpdating = False

        Nome2 = Sheets("Planilha Orçamento").Range("g1")' nome da nova pasta no meu caso valor da celula g1 ira mudar 

        Set CurrentSheet2 = Worksheets("fornecedor") 'a planilha que sera copiada neste caso estou copiando duas 
        Set CurrentSheet3 = Worksheets("Contrato")
        
        On Error Resume Next

        'copia todas as células da planilha ativa
        CurrentSheet2.Cells.Copy ' copia a primeira planilha
        
        'Cria a Nova PASTA (ARQUIVO)
        Set WKB2 = Workbooks.Add

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

        Application.CutCopyMode = False

        'Define o Novo Nome Pasta
        NovoNome2 = Nome2

        'Renomeia a planilha nova com
        'com o nome da planilha no meu caso nome da planilha original
        NomeAba2 = "Fornecedor"
        
        With Worksheets("Plan1")
            .Name = NomeAba2
            .Range("A1").Select
        End With

        Range("A1").Select
        
        
        'outra planilha
        'copia todas as células da planilha ativa
        CurrentSheet3.Cells.Copy
        
        'cola somente os valores na planilha Ativa da nova Pasta,
        'sem formulas e mantenndo a formatação
        With Worksheets("Plan2").Range("A1")
          .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          .PasteSpecial Paste:=xlFormats
        End With

        Application.CutCopyMode = False


        'Renomeia a planilha nova com
        'com o nome da planilha contrato
        NomeAba3 = "Contrato"
        
        With Worksheets("Plan2")
            .Name = NomeAba3
            .Range("A1").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

        'Salva a Nova Pasta no Diretorio abaixo com o mesmo Nome
        'Alterem o mesmo conforme o endereço que querem
         WKB2.SaveAs ThisWorkbook.Path & "" & NovoNome2 & ".xlsx"' desta forma salva na mesma pasta do original
        'WKB2.SaveAs ThisWorkbook.Path & "AAPasta Temporaria" & NovoNome2 & ".xlsx" ' assim ele salva em uma pasta especifica

        WKB2.Close 'retirar este codigo para visualizar a copia da planilha
End Sub

Bom dia!!

Use a pesquisa do fórum!!
http://www.google.com.br/cse?cx=partner ... gsc.page=1

Att

Veja se ajuda, temos duas opções, uma para fazer o que quer em um novo arquivo e outra para uma nova aba :

VBA – CRIANDO UMA CÓPIA SOMENTE DADOS DE UMA PLANILHA NO EXCEL PARA UMA NOVA PASTA
http://www.tomasvasquez.com.br/blog/mic ... nova-pasta

VBA – CRIANDO UMA CÓPIA SOMENTE DADOS DE UMA PLANILHA NO EXCEL
http://www.tomasvasquez.com.br/blog/mic ... a-no-excel

Este assunto tambem foi disseminado no forum abaixo, apesar do titulo não fazer relação, por isto que é importante colocarmos o Titulo condizente com o que queremos.
Criar planilha para envio em e-mail [Resolvido]
http://www.tomasvasquez.com.br/forum/vi ... f=20&t=641

[]s