Excel vba excel exportar csv

[deejaywesley]

Boa tarde e um ótimo domingo amigos!

 

Encontrei esse código na net, que é 99% do que preciso.

Fácil de editar, já que não sou lá essas coisas em VBA, e separa na quantidade que preciso e cria o cabeçalho...

 

Sub prcTrannsferir()

    Dim wbkDestino As Workbook
    Dim wBase As Worksheet
    Dim wDestino As Worksheet
    
    Dim intQtdGruposEnviados As Integer
    Dim intQtdItensPorPlanilha As Integer
    Dim intQtdItensEnviados As Integer
    Dim lngQtdItens As Double
    
    Set wBase = ThisWorkbook.Sheets("wcp")  'Altere para o nome da sua guia que contens os dados
    
    lngQtdItens = wBase.Range("A32000").End(xlUp).Row
    
    intQtdItensPorPlanilha = 999 ' Informe aqui a quantidade de itens por planilha
    intQtdItensEnviados = 0  'não precisa alterar
    intQtdGruposEnviados = 0 ' não precisa alterar
    
    For x = 2 To lngQtdItens   'altere o valor 2 para a linha inicial dos dados da sua planilha
            
        If intQtdItensEnviados = 0 Then
            
            'Cria uma nova guia e cria um cabeçalho na primeira linha
            Set wbkDestino = Workbooks.Add
            Set wDestino = wbkDestino.Sheets.Add
            wDestino.Name = "saldos_estoque"  ' "Grupo " & intQtdGruposEnviados + 1
            
            wDestino.Cells(1, 1).Value = "ID Produto"
            wDestino.Cells(1, 2).Value = "Codigo produto"
            wDestino.Cells(1, 3).Value = "GTIN"
            wDestino.Cells(1, 4).Value = "Descrição Produto"
            wDestino.Cells(1, 5).Value = "Depósito"
            wDestino.Cells(1, 6).Value = "Balanço"
            wDestino.Cells(1, 7).Value = "Valor"
            wDestino.Cells(1, 8).Value = "Preço de Custo"
            wDestino.Cells(1, 9).Value = "Observação"
            
            i = 2
        
        End If
        
        If intQtdItensEnviados < intQtdItensPorPlanilha Then
            
            'Se não chegou ao limite de itens por planilha, copia os dados
            
            wDestino.Cells(i, 1).Value = wBase.Cells(x, 1).Value
            wDestino.Cells(i, 2).Value = wBase.Cells(x, 2).Value
            wDestino.Cells(i, 3).Value = wBase.Cells(x, 3).Value
            wDestino.Cells(i, 4).Value = wBase.Cells(x, 4).Value
            wDestino.Cells(i, 5).Value = wBase.Cells(x, 5).Value
            wDestino.Cells(i, 6).Value = wBase.Cells(x, 6).Value
            wDestino.Cells(i, 7).Value = wBase.Cells(x, 7).Value
            wDestino.Cells(i, 8).Value = wBase.Cells(x, 8).Value
            wDestino.Cells(i, 9).Value = wBase.Cells(x, 9).Value
            
            intQtdItensEnviados = intQtdItensEnviados + 1
            i = i + 1
        
        End If
        
        If intQtdItensEnviados = intQtdItensPorPlanilha Or x = lngQtdItens Then
            
            'Se chegou ao limite, inicia o contador de itens enviados e incrementa a quantidade de grupos
            wbkDestino.SaveAs ThisWorkbook.Path & "\" & "Grupo " & intQtdGruposEnviados + 1 ' wDestino.Name
            wbkDestino.Close
            intQtdItensEnviados = 0
            intQtdGruposEnviados = intQtdGruposEnviados + 1
            
        End If
        
    Next x
Call RenameSheet
End Sub

 

O problema é que esta salvando no formato do Excel, e eu preciso que ele salve e em CSV, ate achei um parecido que salva em CSV mas não é o CSV certo, sim o site do sistema que tenho que subir o balanço de estoque é exigente kkkkk

 

alguém consegue altera-lo para mim, ou tem outro que faça o mesmo e salve no bendito CSV.

segue a imagem com o CSV que preciso que seja salvo.

 

 

não sei se faz diferença, mas uso o office 2007.

 

obrigado a todos!

[Basole]

@deejaywesley substitua a linha abaixo no seu código

 

  wbkDestino.SaveAs ThisWorkbook.Path & "\" & "Grupo " & intQtdGruposEnviados + 1, FileFormat:=xlCSV, local:=True 

 

[deejaywesley]

Muito boa noite amigo @Basole

 

Muito obrigado pela resposta, está salvando no formato certinho que preciso 

mas como felicidade de pobre dura pouco, mesmo estando no formato correto, quando upo elas para o site, ele não reconhece e da erro, mas deve ser uma coisa à toa que esta faltando, vou continuar dando uma pesquisada aqui.

 

forte abraço parceiro.

fica com Deus!