Excel macro para salvar em csv

[Matheus Ittner Giampiccolo]

Eai pessoal, beleza?

 

com uma planilha que precisa criar um macro (botão) para que atuomaticamente abra a caixa de "salvar como" já selecionado o formato "csv separado por virgulas"

deixando somente o passo de inserir o nome manual.

 

alguem conseguiria me ajudar?

[Midori]

Pode ser feito assim,

 

Application.GetSaveAsFilename FileFilter:="Delimitado por vírgulas (*.csv), *.csv"

 

[Matheus Ittner Giampiccolo]

@Midori

 

sou leigo no VBA, não sei inserir isso como macro.

poderias me ajudar como configurar isso por favor?

31 minutos atrás, Midori disse:

Pode ser feito assim,

 

Application.GetSaveAsFilename FileFilter:="Delimitado por vírgulas (*.csv), *.csv"

 

sou leigo no VBA, não sei inserir isso como macro.

poderias me ajudar como configurar isso por favor?

[Midori]

@Matheus Ittner Giampiccolo  No menu Desenvolvedor escolha Inserir > Controles Active X > Botão de Comando.

 

Após desenhar o botão na planilha dê dois cliques nele para abrir o editor e cole o código assim,

 

Private Sub CommandButton1_Click()
Application.GetSaveAsFilename FileFilter:="Delimitado por vírgulas (*.csv), *.csv"
End Sub

 

Para funcionar volte para a planilha e desmarque a opção Modo de Design do menu Desenvolvedor.

 

Aqui também tem um passo a passo,

 

https://support.microsoft.com/en-us/office/assign-a-macro-to-a-form-or-a-control-button-d58edd7d-cb04-4964-bead-9c72c843a283

 

[Matheus Ittner Giampiccolo]

29 minutos atrás, Midori disse:

@Matheus Ittner Giampiccolo  No menu Desenvolvedor escolha Inserir > Controles Active X > Botão de Comando.

 

Após desenhar o botão na planilha dê dois cliques nele para abrir o editor e cole o código assim,

 

Private Sub CommandButton1_Click()
Application.GetSaveAsFilename FileFilter:="Delimitado por vírgulas (*.csv), *.csv"
End Sub

 

Para funcionar volte para a planilha e desmarque a opção Modo de Design do menu Desenvolvedor.

 

Aqui também tem um passo a passo,

 

https://support.microsoft.com/en-us/office/assign-a-macro-to-a-form-or-a-control-button-d58edd7d-cb04-4964-bead-9c72c843a283

 

 

Consegui fazer o botão e abre a caixa para salvar, porém nao conclui 

 

quando salvo, depois vou na pasta e não esta la

 

 

[Midori]

@Matheus Ittner Giampiccolo  Essa função é para atribuir o nome do arquivo, para salvar pode ser assim,

 

Private Sub CommandButton1_Click()
    Dim Arquivo As String
    
    Arquivo = Application.GetSaveAsFilename( _
        FileFilter:="Delimitado por vírgulas (*.csv), *.csv")
    
    ThisWorkbook.ActiveSheet.Copy
    ActiveWorkbook.SaveAs Arquivo, xlCSV
    ActiveWorkbook.Close
End Sub

 

[Matheus Ittner Giampiccolo]

28 minutos atrás, Midori disse:

@Matheus Ittner Giampiccolo  Essa função é para atribuir o nome do arquivo, para salvar pode ser assim,

 

Private Sub CommandButton1_Click()
    Dim Arquivo As String
    
    Arquivo = Application.GetSaveAsFilename( _
        FileFilter:="Delimitado por vírgulas (*.csv), *.csv")
    
    ThisWorkbook.ActiveSheet.Copy
    ActiveWorkbook.SaveAs Arquivo, xlCSV
    ActiveWorkbook.Close
End Sub

 

Agora esta salvando certinho, porém fica esses ,,,, nas celulas abaixo, teriam que ficam em branco

[Midori]

Se puder anexar o arquivo vai ficar mais fácil ajudar nisso, mas essas linhas devem ter fórmulas ou caractere vazio, por isso fica assim. Para remover essa vírgulas tem que identificar a última linha com os dados e apagar antes de salvar. Isso pode ser feito via macro com uma função que conte a coluna correta. Supondo que seja a coluna E,

 

Private Sub CommandButton1_Click()
    Dim Arquivo As String
    Dim Linhas  As Long
    
    Arquivo = Application.GetSaveAsFilename( _
        FileFilter:="Delimitado por vírgulas (*.csv), *.csv")
        
    ThisWorkbook.ActiveSheet.Copy
    
    With ActiveWorkbook.ActiveSheet
        Linhas = WorksheetFunction.CountA(.[E:E])
        .Range(.Cells(Linhas + 1, 1), _
            .Cells([A:A].Rows.Count, 1)).EntireRow.Clear
    End With
    ActiveWorkbook.SaveAs Arquivo, xlCSV
    ActiveWorkbook.Close
End Sub

 

[Matheus Ittner Giampiccolo]

37 minutos atrás, Midori disse:

Se puder anexar o arquivo vai ficar mais fácil ajudar nisso, mas essas linhas devem ter fórmulas ou caractere vazio, por isso fica assim. Para remover essa vírgulas tem que identificar a última linha com os dados e apagar antes de salvar. Isso pode ser feito via macro com uma função que conte a coluna correta. Supondo que seja a coluna E,

 

Private Sub CommandButton1_Click()
    Dim Arquivo As String
    Dim Linhas  As Long
    
    Arquivo = Application.GetSaveAsFilename( _
        FileFilter:="Delimitado por vírgulas (*.csv), *.csv")
        
    ThisWorkbook.ActiveSheet.Copy
    
    With ActiveWorkbook.ActiveSheet
        Linhas = WorksheetFunction.CountA(.[E:E])
        .Range(.Cells(Linhas + 1, 1), _
            .Cells([A:A].Rows.Count, 1)).EntireRow.Clear
    End With
    ActiveWorkbook.SaveAs Arquivo, xlCSV
    ActiveWorkbook.Close
End Sub

 

exclui as linhas abaixo para limpar elas, agora funcionou!

Muito obrigado pela ajuda!!!!

tenho como configurar para salvar em uma pasta especifica?

 

C:\Users\User\Desktop\cote fácil 

este seria o caminho

[Midori]

@Matheus Ittner Giampiccolo Você pode passar o diretório para o parâmetro da função, aí a janela sempre vai abrir nessa pasta,

 

Private Sub CommandButton1_Click()
    Dim Arquivo As Variant
    Dim Linhas  As Long
    
    Arquivo = Application.GetSaveAsFilename( _
        InitialFileName:="C:\Users\User\Desktop\cote fácil\", _
        FileFilter:="Delimitado por vírgulas (*.csv), *.csv")
    
    If Arquivo <> False Then
        ThisWorkbook.ActiveSheet.Copy
    
        With ActiveWorkbook.ActiveSheet
            Linhas = WorksheetFunction.CountA(.[E:E])
            .Range(.Cells(Linhas + 1, 1), _
                .Cells([A:A].Rows.Count, 1)).EntireRow.Clear
        End With
        ActiveWorkbook.SaveAs Arquivo, xlCSV
        ActiveWorkbook.Close
    End If
End Sub

 

Mas se não quiser dar a opção de escolher a pasta, pode atribuir o diretório para uma variável e depois concatenar com outra só com o nome do arquivo.

[Matheus Ittner Giampiccolo]

40 minutos atrás, Midori disse:

@Matheus Ittner Giampiccolo Você pode passar o diretório para o parâmetro da função, aí a janela sempre vai abrir nessa pasta,

 

Private Sub CommandButton1_Click()
    Dim Arquivo As Variant
    Dim Linhas  As Long
    
    Arquivo = Application.GetSaveAsFilename( _
        InitialFileName:="C:\Users\User\Desktop\cote fácil\", _
        FileFilter:="Delimitado por vírgulas (*.csv), *.csv")
    
    If Arquivo <> False Then
        ThisWorkbook.ActiveSheet.Copy
    
        With ActiveWorkbook.ActiveSheet
            Linhas = WorksheetFunction.CountA(.[E:E])
            .Range(.Cells(Linhas + 1, 1), _
                .Cells([A:A].Rows.Count, 1)).EntireRow.Clear
        End With
        ActiveWorkbook.SaveAs Arquivo, xlCSV
        ActiveWorkbook.Close
    End If
End Sub

 

Mas se não quiser dar a opção de escolher a pasta, pode atribuir o diretório para uma variável e depois concatenar com outra só com o nome do arquivo.

Consegui fazer abrir direto na pasta que desejo selecionar.

Porém só agora percebi que o arquivo esta sendo salvo separando por virgula, preciso de separe por ";"

será que é possivel?

agora, Matheus Ittner Giampiccolo disse:

Consegui fazer abrir direto na pasta que desejo selecionar.

Porém só agora percebi que o arquivo esta sendo salvo separando por virgula, preciso de separe por ";"

será que é possivel?

de

[Midori]

11 minutos atrás, Matheus Ittner Giampiccolo disse:

Porém só agora percebi que o arquivo esta sendo salvo separando por virgula, preciso de separe por ";"

será que é possivel?

 

Veja se resolve atribuindo True ao parâmetro Local. Deixe a linha do SaveAs assim,

 

ActiveWorkbook.SaveAs Filename:=Arquivo, FileFormat:=xlCSV, Local:=True

 

[Matheus Ittner Giampiccolo]

agora, Midori disse:

 

Veja se resolve atribuindo true ao parâmetro Local. Deixe a linha do SaveAs assim,

 

ActiveWorkbook.SaveAs Filename:=Arquivo, FileFormat:=xlCSV, Local:=True

 

agora foi, porém abre novamente essa janela de salvar alterações.

 

se clico em salvar voltar ao padrão errado, se não salvo fica correto

 

[Midori]

9 minutos atrás, Matheus Ittner Giampiccolo disse:

agora foi, porém abre novamente essa janela de salvar alterações.

 

se clico em salvar voltar ao padrão errado, se não salvo fica correto

Deve ter outra planilha ativa rodando a macro anterior.

 

Feche tudo e tente novamente com essa última macro.

[Matheus Ittner Giampiccolo]

8 minutos atrás, Midori disse:

Deve ter outra planilha ativa rodando a macro anterior.

 

Feche tudo e tente novamente com essa última macro.

refiz do zero tudo e continuar abrindo a janela de salvar ou não( mesmo ja tendo sido salvo)

ps. o arquivo ja foi salvo corretamente, ele é aberto automaticamente, quando é fechado solicita salvar

[Midori]

@Matheus Ittner Giampiccolo A macro exibe uma mensagem de confirmação no caso de tentar salvar um arquivo com o mesmo nome de um já existente. A outra mensagem deve ser por alguma atualização na planilha feita antes de fechar, pode ser uma fórmula. Veja se com DisplayAlerts resolve,

 

Private Sub CommandButton1_Click()
    Dim Arquivo As Variant
    Dim Linhas  As Long
    
    Arquivo = Application.GetSaveAsFilename( _
        InitialFileName:="C:\Users\User\Desktop\cote fácil\", _
        FileFilter:="Delimitado por vírgulas (*.csv), *.csv")
    
    If Arquivo <> False Then
        ThisWorkbook.ActiveSheet.Copy
    
        With ActiveWorkbook.ActiveSheet
            Linhas = WorksheetFunction.CountA(.[E:E])
            .Range(.Cells(Linhas + 1, 1), _
                .Cells([A:A].Rows.Count, 1)).EntireRow.Clear
        End With
        ActiveWorkbook.SaveAs Filename:=Arquivo, FileFormat:=xlCSV, Local:=True
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
    End If
End Sub

 

[Matheus Ittner Giampiccolo]

59 minutos atrás, Midori disse:

@Matheus Ittner Giampiccolo A macro exibe uma mensagem de confirmação no caso de tentar salvar um arquivo com o mesmo nome de um já existente. A outra mensagem deve ser por alguma atualização na planilha feita antes de fechar, pode ser uma fórmula. Veja se com DisplayAlerts resolve,

 

Private Sub CommandButton1_Click()
    Dim Arquivo As Variant
    Dim Linhas  As Long
    
    Arquivo = Application.GetSaveAsFilename( _
        InitialFileName:="C:\Users\User\Desktop\cote fácil\", _
        FileFilter:="Delimitado por vírgulas (*.csv), *.csv")
    
    If Arquivo <> False Then
        ThisWorkbook.ActiveSheet.Copy
    
        With ActiveWorkbook.ActiveSheet
            Linhas = WorksheetFunction.CountA(.[E:E])
            .Range(.Cells(Linhas + 1, 1), _
                .Cells([A:A].Rows.Count, 1)).EntireRow.Clear
        End With
        ActiveWorkbook.SaveAs Filename:=Arquivo, FileFormat:=xlCSV, Local:=True
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
    End If
End Sub

 

agora foi!!! troquei de pc, show obrigado

poderia me ajudar com o codigo para preenchimento automatico da coluna E (é uma formula). queria que fosse em um botão também, mas deve terminar quando as outra colunas estiverem vazias.

 

[Midori]

@Matheus Ittner Giampiccolo Pegue alguma coluna como referência da última linha preenchida com xlDown. Usando a D fica assim,

 

[E1].AutoFill [E1].Resize([D1].End(xlDown).Row)

 

[Matheus Ittner Giampiccolo]

5 horas atrás, Midori disse:

@Matheus Ittner Giampiccolo Pegue alguma coluna como referência da última linha preenchida com xlDown. Usando a D fica assim,

 

[E1].AutoFill [E1].Resize([D1].End(xlDown).Row)

 

Muito obrigado deu certo

me salvasse, nem sei como agradecer!!!!

obrigado mesmo

[Patropi]

@Matheus Ittner Giampiccolo

 

Para agradecer, clique em Curtir nas respostas da Midori

 

[]s

[Gabriel Spinola]

Boa Tarde Midori

Copiei o código que você criou acima e ele salva tudo certo. Porém quando eu abro no notepad++, aparece uma linha em branco a mais do que a tabela tem. Isso atrapalha meu fluxo para frente com esse arquivo.
 

sabe como me ajudar?

 

Private Sub CommandButton1_Click()
    Dim Arquivo As Variant
    Dim Linhas  As Long
    
    Arquivo = Application.GetSaveAsFilename( _
        InitialFileName:="C:\Users\Public\", _
        FileFilter:="Delimitado por vírgulas (*.csv), *.csv")
    
    If Arquivo <> False Then
        ThisWorkbook.ActiveSheet.Copy
    
        With ActiveWorkbook.ActiveSheet
            Linhas = WorksheetFunction.CountA(.[O:O])
            .Range(.Cells(Linhas + 1, 1), _
                .Cells([A:A].Rows.Count, 1)).EntireRow.Delete
        End With
        ActiveWorkbook.SaveAs Filename:=Arquivo, FileFormat:=xlCSV, Local:=False
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
    End If
End Sub

 

 

No excel não tem nada nas linhas abaixo da tabela preenchida.

 

[Midori]

@Gabriel Spinola Sempre terá uma linha sem dados na última do arquivo csv. Isso é comum em arquivos texto por causa do Carriage Return (caractere de retorno de carro). No VBA é a constante vbCr (ou vbCrLf) para mover o cursor para a próxima linha como se fosse o enter. Uma forma remover o caractere vbCr da última linha é com outra macro para ler todas as linhas do arquivo csv e ir copiando para outro, aí quando chegar na última linha não coloca o vbCr.

[Marcos_22]

Midori, boa noite! Gostaria de usar a mesma macro que fez para o Matheus, porém a mesma deve salvar diretamente o arquivo em determinada pasta e não deve abrir o "salvar como". Qual alteração deve ser feita? Além disso, gostaria de usar a macro no Módulo1, ou seja, terá que especificar na macro a qual worksheet se refere. Consegue ajudar? Segue abaixo a macro.

 

[Midori]

@Marcos_22 Pode criar um novo tópico e explicar isso lá? E se possível com uma planilha, pode ser com dados fictícios, para usar como exemplo.

[Marcos_22]

Ok já criei novo tópico. Obrigado!