Henrique Flausino

Sub ImportarTXT()

    Dim Pasta As String

    Dim Arquivo As String

    Dim LinInicial As Long

    Dim LinFinal As Long


    'Abre caixa de diálogo para selecionar a pasta onde estão

    'os arquivos

    With Application.FileDialog(msoFileDialogFolderPicker)

       .Show

       Pasta = .SelectedItems(1)

    End With


    Arquivo = Dir(Pasta & "\*.txt")


    'Laço para abrir cada um dos arquivos

    While Arquivo <> ""


        Workbooks.OpenText Filename:=Pasta & "\" & Arquivo, _

        DataType:=xlDelimited, StartRow:=2, Other:=True, OtherChar:=";", _

        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 9), Array(8, 9), Array(9, 9), Array(10, 9), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 9), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _

        Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 9), Array(26, 9), Array(27, 9), Array(28, 9), Array(29, 9), Array(30, 9), Array(31, 9), Array(32, 9), Array(33, 9), Array(34, 9), Array(35, 9), Array(36, 9), Array(37, 1), Array(38, 1), Array(39, 9))

        'Linha inicial onde deve-se colocar o nome do arquivo

        LinInicial = ThisWorkbook.ActiveSheet.Range("B" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Row

        ActiveSheet.[A1].CurrentRegion.Copy _

        ThisWorkbook.ActiveSheet.Range("B" & Cells.Rows.Count).End(xlUp).Offset(1, 0)


        ActiveWorkbook.Close False

        Arquivo = Dir

        DoEvents

    Wend

        Cells.Replace What:="-", Replacement:="", LookAt:=xlPart, SearchOrder:= _

        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        Cells.Replace What:="/", Replacement:="", LookAt:=xlPart, SearchOrder:= _

        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        Cells.Replace What:=".", Replacement:="", LookAt:=xlPart, SearchOrder:= _

        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

            Range("A2").Select

            ActiveCell.FormulaR1C1 = "1"

            Range("A3").Select

            ActiveCell.FormulaR1C1 = "2"

            Range("A2:A3").Select

            Selection.AutoFill Destination:=Range("A2:A12501"), Type:=xlFillDefault

            Range("A2:A12501").Select

    MsgBox "Importação Completa"

End Sub