Boa tard!!
Tlavez eu não possa ajuda-lo mas...
Tente ver uma adaptação...
Option Explicit
Sub Test()
Dim fs, filepath As Variant
Dim i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Altere o caminho a seguir para apontar para onde seus arquivos são armazenados.
filepath = "C:TEST"
'Isto irá procurar todos os arquivos dentro da pasta
Set fs = Application.FileSearch
With fs
.NewSearch
.Filename = "*.txt"
.SearchSubFolders = True 'comentar esta linha se os arquivos não são armazenados em subpastas
.LookIn = filepath
If .Execute > 0 Then
'Para cada arquivo que ele encontra ...
For i = 1 To .FoundFiles.Count
'...abra o...
Workbooks.Open (.FoundFiles(i))
'Quebrar Coluna A em delimitado por colunas,
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True
'e movê-lo para este livro!
ActiveSheet.Move After:=ThisWorkbook.Sheets(1)
Next i
Else
MsgBox "Arquivos não encontrados."
End If
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub OutraFonte()
ActiveSheet.Paste
Selection.TextToColumns Destination:=Range(ActiveCell, ActiveCell), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 2), TrailingMinusNumbers:=True
End Sub
Att
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 07/02/2013 11:16 am