Este fórum está sendo desativado

[DiogoBras]

Boa tarde,

Sou um utilizador muito iniciante do VBA/Macros.
Criei uma Macro (ver abaixo), que me faz procurar no meu computador ficheiros .CSV, e os importa para o Excel.

Até aqui corre tudo bem, importo todos os ficheiros sem problema algum.
Estou agora à luta, a tentar perceber como posso adicionar uma coluna com o nome do fichiero .CSV.

podem ajudar? abraço.




Sub Import()

Dim myfiles
Dim i As Integer

myfiles = Application.GetOpenFilename(filefilter:="CSV Files (*.csv), *.csv", MultiSelect:=True)

If Not IsEmpty(myfiles) Then
For i = LBound(myfiles) To UBound(myfiles)

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myfiles(i), Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1, 0))
.Name = "CSV"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.TextFileThousandsSeparator = ","
.Refresh BackgroundQuery:=False

End With

Next i
Else
MsgBox "No files Selected"
End If
End Sub

[alexandrevba]

Boa tarde!!!

Eu naõ testei e não tomei como base se codigo.

Tente algo assim...

Código: Selecionar todos

Dim r As Long
'************
With ActiveSheet
        r = .UsedRange.Row + .UsedRange.Rows.Count
        Set destCell = .Cells(r, "B") 'Mude para a coluna que desejar
    End With

Codigo de JBeucare

Código: Selecionar todos

Sub ImportManyTXTIntoColumns()

    Dim fPath As String, fTXT As String
    Dim wsTrgt As Worksheet, NC As Long
    Application.ScreenUpdating = False
    fPath = "T:\Desktop\test\"                      'path to files, remember the final \
    Set wsTrgt = ThisWorkbook.Sheets.Add    'new sheet for incoming data
    NC = 1                                  'first column for data

    fTXT = Dir(fPath & "*.txt")             'get first filename

    Do While Len(fTXT) > 0              'process one at a time
                                        'open the file in Excel
        Workbooks.OpenText fPath & fTXT, Origin:=437
                                        'put the filename in the target column
        wsTrgt.Cells(1, NC) = ActiveSheet.Name 'Aqui o nome do arquivo vai para ultima coluna
                                        'copy column A to new sheet
        Range("A:A").SpecialCells(xlConstants).Copy wsTrgt.Cells(2, NC)

        wsTrgt.Range("A16:A2815").Select
            Range(Selection, Selection.End(xlDown)).Select
             Selection.TextToColumns Destination:=wsTrgt.Range("A16:A2815"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
             Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

        ActiveWorkbook.Close False      'close the source file

        NC = NC + 2                     'next column
        fTXT = Dir                      'next file
    Loop

    Application.ScreenUpdating = True
End Sub

Att