Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Abertura de arquivo...
 
Notifications
Clear all

Abertura de arquivo csv pelo vba - vem desconfigurado

 
2024 - VBA & Macros
Post Recente por bruna.lwm 1 ano atrás
3 Posts
2 Usuários
1 Reactions
727 Visualizações
RSS
 bruna.lwm
(@bruna-lwm)
Posts: 0
New Member
Topic starter
 

Bom dia, 

Estou fazendo uma macro para compilar arquivos csv em uma unica planilha, porém ao importar um arquivo csv através do vba o arquivo vem desconfigurado. 

Se abrir o arquivo sem o vba ele já está com a separação de colunas feita corretamente. 

Poderiam me ajudar a corrigir este erro?

Obs: Sou nova com essa parte de vba. É a primeira macro que eu faço e peguei um código em uma aula no youtube.

 

Segue o código atual e no anexo a planilha que estou tentando compilar:

Sub rodarCompilacao()

ultLin = ThisWorkbook.Sheets(1).Range("A1000000").End(xlUp).Row
If ultLin > 1 Then
ThisWorkbook.Sheets(1).Range("A2:I" & ultLin).Delete Shift:=xlUp
End If

caminhoPasta = "C:\Users\bruna\Meu Drive\Backtest\Dólar_4-16-5R"
Set pasta = CreateObject("Scripting.FileSystemObject").GetFolder(caminhoPasta)

For Each arquivo In pasta.Files

Set arquivo = Workbooks.Open(caminhoPasta & "\" & arquivo.Name)

ultiLin = arquivo.Sheets(1).Range("A6").End(xlDown).Row
arquivo.Sheets(1).Range("A6:I" & ultLin).Copy

priLin = ThisWorkbook.Sheets(1).Range("A1000000").End(xlUp).Row + 1
ThisWorkbook.Sheets(1).Cells(priLin, 1).PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False
arquivo.Close False

Next

End Sub

Sub estrutraRepeticao()

For Each celula In Range("A6:I6")
MsgBox celula.Value
Next

 

Obrigada

 
Postado : 27/07/2023 10:48 am
 Osvaldomp
(@osvaldomp)
Posts: 857
Prominent Member
 

Olá, Bruna.

Veja se o código abaixo faz o que você quer.

Sub ConsolidaArquivosCSV()
Dim StrArq As String, UL As Long, ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
StrArq = Dir("C:\Users\bruna\Meu Drive\Backtest\Dólar_4-16-5R\")
Application.ScreenUpdating = False
If ws.[A2] <> "" Then ws.Range("A2:I" & ws.Cells(Rows.Count, 1).End(3).Row) = ""
Do While Len(StrArq) > 0
Workbooks.OpenText Filename:="C:\TestesProv\" & StrArq, DataType:=xlDelimited, Semicolon:=True, Local:=True
Range("A6:I" & Cells(Rows.Count, 1).End(3).Row).Copy ws.Cells(Rows.Count, 1).End(3)(2)
ActiveWorkbook.Close False
StrArq = Dir
Loop
Columns("A:D").AutoFit
End Sub

 

obs.

1. considerei que na pasta indicada existem somente arquivos .csv e que todos serão copiados, como está no seu código original

1. considerei que os arquivos .csv a serem copiados têm somente uma planilha

 
Postado : 28/07/2023 5:42 pm
 bruna.lwm
(@bruna-lwm)
Posts: 0
New Member
Topic starter
 

Deu certo. Muuuuito obrigada! 🤩 

 
Postado : 31/07/2023 10:38 am
Osvaldomp reacted
Forum Jump:
  Tópico Anterior
Próximo Tópico