Erro de compatibilidade

[Henrique Flausino]

Boa tarde,

 

Estou com problema de compatibilidade neste código.

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

Este código funciona normalmente quanto o arquivo está salvo como xlsm, mas tenho que usar ele em xls e não roda.

Alguém poderia me ajudar a identificar o motivo do problema e qual a solução.

 

 

Agradeço pela ajuda.