salvar dados em uma nova pasta de trabalho (planilha unica)

2024 - VBA & Macros

Post Recente por França 6 anos atrás

5 Posts

4 Usuários

0 Reactions

1,107 Visualizações

RSS

França

(@franca)

Posts: 21

Eminent Member

Topic starter

Boa tarde a todos achei um código em um fórum que salva os dados da sua planilha ("pasta de trabalho") em uma planilha totalmente independente...só que ela salva planilha por planilha que estiver na pasta de trabalho.... gostaria de de tirar somente o laço que que salva todas as planilhas... gostaria de salvar a planilha especifica. exemplo: tenho planilha 1, 2, 3 em minha pasta de trabalho e quero salvar somente a 2 e quando salvar em uma pasta independente apagar a a restante ficando somente 1
porque são dois laços um que salva todas as planilhas existentes em planilhas independentes e outra que apaga planilhas 2, 3 da mesma. segue o código desde ja agradeço.

Dim newBook As Workbook
    Dim sheet As Worksheet
    Dim i As Byte
 
    'Desativa os avisos e atualiação da tela
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    For Each sheet In ThisWorkbook.Worksheets
        'cria uma nova pasta de trabalho:
        Set newBook = Application.Workbooks.Add
        'copia a planilha
        sheet.Copy Before:=newBook.Sheets(1)
        'remove as outras
        For i = 2 To newBook.Worksheets.Count
            newBook.Worksheets(2).Delete
        Next i
        'salva o arquivo
        pasta = Application.GetSaveAsFilename
        newBook.SaveAs pasta & ".xlsx"
        newBook.Close
    Next sheet
 
TrataSaida:
    'Reativa os avisos e atualiação da tela
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    'zera as variáveis
    Set newBook = Nothing
    Set sheet = Nothing
    MsgBox "Feito!"
    Exit Sub
TrataErro:
    MsgBox Err.Description, vbCritical, "Erro"
    GoTo TrataSaida

Postado : 06/07/2018 11:19 am

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Movi teu tópico para o local correto que é VBA & Macros, que é o assunto da tua dúvida, pois você havia postado na sala exclusiva par a apresentação dos novos usuários.

[]s

Patropi - Moderador

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 06/07/2018 1:29 pm

Wagner Morel

(@wagner-morel-vidal-nobre)

Posts: 0

Illustrious Member

França,

Boa noite!

Faça assim:

    Dim newBook As Workbook
    Dim sheet As Worksheet
    Dim i As Byte

    'Desativa os avisos e atualiação da tela
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each sheet In ThisWorkbook.Worksheets
        If sheet.Index = 2 Then
            'cria uma nova pasta de trabalho:
            Set newBook = Application.Workbooks.Add
            'copia a planilha
            sheet.Copy Before:=newBook.Sheets(1)
            'remove as outras
            For i = 2 To newBook.Worksheets.Count
                newBook.Worksheets(2).Delete
            Next i
            'salva o arquivo
            pasta = Application.GetSaveAsFilename
            newBook.SaveAs pasta & ".xlsx"
            newBook.Close
        End If
    Next sheet
    
TrataSaida:
        'Reativa os avisos e atualiação da tela
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        'zera as variáveis
        Set newBook = Nothing
        Set sheet = Nothing
        MsgBox "Feito!"
        Exit Sub
TrataErro:
        MsgBox Err.Description, vbCritical, "Erro"
        GoTo TrataSaida

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

Postado : 06/07/2018 3:05 pm

MPrudencio

(@mprudencio)

Posts: 2749

Famed Member

Se eu entendi este codigo atende

Sub CopiaPlanilha()

Dim Caminho As String

Caminho = "C:Users" & Environ("User Name") & "Desktop" 'Altere o Caminho onde salvar o arquivo

    Sheets("Planilha2").Copy 'Altere o nome da guia de acordo com a necessidade
    ChDir Caminho
    ActiveWorkbook.SaveAs Filename:=Caminho & "Pasta.xlsx"
    ActiveWindow.Close
End Sub

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

Postado : 06/07/2018 4:56 pm