Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Quebra de linha ao ...
 
Notifications
Clear all

Quebra de linha ao importar um arquivo txt

 
2024 - VBA & Macros
2 Posts
2 Usuários
0 Reactions
854 Visualizações
RSS
 hyonxd
(@hyonxd)
Posts: 8
Active Member
Topic starter
 

Olá galera,

Estou com um problema de que quando importo um arquivo txt, ele desloca todo conteúdo que já estava no lugar para direita ->
E queria que ele colocasse para baixo /

Tentei gravar diferentes macros colocando ctrl pra baixo e de todo jeito, alguém sabe como fazer?

Segue o código:

Sub importar_com_historico()
'
' importar_com_historico Macro
'
    Sheets("Base").Select
    Selection.End(xlToLeft).Select
    Selection.End(xlUp).Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:UsersDesktopchubaca.txt", Destination:=Range("$A$1"))
        .Name = "chubaca_12"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertEntireRows
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Sheets("Macro").Select
    Range("A1").Select
End Sub
 
Postado : 25/10/2016 6:54 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!
Tente

Sub AleVBA_22352()
Dim fName As String, LastRow As Long

'fName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fName = "False" Then Exit Sub

LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & "C:UsersAleVBADesktopdeleteeee.txt", _
        Destination:=Range("A" & LastRow))
            .Name = "sample"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierNone
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "" & Chr(10) & ""
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
               1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
    End With
End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 25/10/2016 8:21 am
Forum Jump:
  Tópico Anterior
Próximo Tópico