[Resolvido] Transformar csv em xls

2024 - VBA & Macros

Post Recente por Anderson 4 anos atrás

4 Posts

3 Usuários

0 Reactions

1,840 Visualizações

RSS

vxavier

(@vxavier)

Posts: 6

Active Member

Topic starter

Bom dia,
Salve salve pessoal do fórum, tudo bom ?
Preciso de ajuda no seguinte, em transformar arquivos .csv em arquivos .xls.
Quando eu abro o csv normal no excel, ele abre legal divididos em colunas e tal, bonito. Mas quando eu utilizo uma macro para fazer esta transformação de .csv para .xls, ele fica em uma célula separado por ;. Como eu consigo remover este ; e dividir em colunas legalzinho ? Seguem dois arquivos em anexo.

Se eu abrir cada arquivo e salvar manualmente o arquivo fica legal como o arquivo em anexo 3300936, mas se eu fizer a mudança utilizando uma macro o arquivo fica como o arquivo 0.

Estou utilizado a seguinte macro.
Obs: Grande parte da Macro abaixo é uma reutilização do meu problema anterior que o nosso Amigo Wagner Morel me ajudou a resolver.

Sub CopiarDados()
    'Desabilita a atualização automática
    Application.ScreenUpdating = False
    
    '************************************************
    'NECESSITA DA REFERÊNCIA Microsoft Scripting Runtime
    '************************************************
    
    'Declaração de variáveis
    Dim fso As Scripting.FileSystemObject
    Dim fld As Scripting.Folder
    Dim fl As Scripting.File
    Dim UltimaLinha As Long
    Dim strCaminho As String
    Dim i As Integer
    i = 0
    'Esse é o caminho onde estão os arquivos. Seu arquivo de macro deve estar no mesmo caminho
    strCaminho = ActiveWorkbook.Path & ""
    
    'Aqui é criado o objeto que comunica com as pastas do computador
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'Esse objeto executa um método do FileSystemObject
    'para buscar atribuir à variável fld uma pasta
    Set fld = fso.GetFolder(strCaminho)
    
    'Loop em cada elemento (ou seja, arquivo) do caminho desejado:
    For Each fl In fld.Files
        'Verifica se é um arquivo com extensão Csv
        If Right(fl.Name, 4) = ".CSV" Or Right(fl.Name, 4) = ".csv" Then
            'Abre o arquivo
            Workbooks.Open strCaminho & fl.Name
            
            ActiveWorkbook.SaveAs Filename:="C:obitos" & i & ".xls", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            
        
            
             Workbooks.Close
            
            
        End If
        i = i + 1
    Next
    'Habilita a atualização automática
    Application.ScreenUpdating = True
    
    MsgBox "Arquivos alterados com Sucesso!"
End Sub

obrigado

arquivos.rar

Postado : 17/07/2014 8:52 am

vxavier

(@vxavier)

Posts: 6

Active Member

Topic starter

Esse Código funcionou perfeitamente.


Sub Macro5()
'
' Macro5 Macro
'
' Atalho do teclado: Ctrl+h
'
  
Dim wb As Workbook
Dim strFile As String, strDir As String, strOut_Dir As String, myNewFileName As String

strDir = "C:" 'location of csv files
strOut_Dir = "C:" 'location of xls files
strFile = Dir(strDir & "*.csv")

Do While strFile <> ""

    Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
   
    With wb
         .SaveAs Replace(wb.FullName, ".csv", ".xls"), 56 'UPDATE:
        .Close True
    End With
    Set wb = Nothing
strFile = Dir

Loop
  
End Sub

Postado : 17/07/2014 2:32 pm