Boa tarde,

Veja se, desta forma, atende:

Sub CREATEFILE()
    On Error GoTo TratarErro

    Dim lsCaminho   As String
    Dim llArquivo   As Long
    Dim llLinha     As String
    Dim lContador   As Long
    Dim iTotalLinhas As Long
    Dim Colecao As New Collection
    Dim Repetido As Boolean
    
    Close
    'Caminho aonde será salvo o arquivo
    lsCaminho = InputBox("Caminho e nome do arquivo:                              Exemplo-  C:ARQUIVO_APB ", "Caminho do arquivo", ActName) & ".txt"

    'Identifica se o arquivo já existe
    If Dir(lsCaminho) = "" Then
        llArquivo = FreeFile
        
        
        Open lsCaminho For Output As #llArquivo
        
        
        Selection.End(xlDown).Select
        iTotalLinhas = Cells(Rows.Count, 1).End(xlUp).Row
        While lContador < iTotalLinhas
            lContador = lContador + 1
            
            Repetido = False
            'Inclui na coleção se não for repetido
            Colecao.Add Cells(lContador, 1).Value, CStr(Cells(lContador, 1).Value)
            
            'Escreve os dados no arquivo
            If Repetido = False Then Print #llArquivo, Cells(lContador, 1)
            
        Wend
        
        MsgBox "Arquivo Salvo em: " & lsCaminho
        
        'Fecha o arquivo
        Close #llArquivo
    Else
        MsgBox "Arquivo já existe!"
    End If

'Tratamento de erro
Sair:
    Exit Sub
TratarErro:
    If Err.Number = 457 Then
        Repetido = True
        Resume Next
    End If
    MsgBox "Houve um erro na gravação do arquivo!"
    GoTo Sair
    Resume
End Sub

Abraço

Uma outra opção, seria utilizando o Filtro por valores Unicos :

    Sub CREATEFILE_FILTER()
        On Error GoTo TratarErro

        Dim lsCaminho   As String
        Dim llArquivo   As Long
        Dim llLinha     As String
        Dim lContador   As Long
        Dim iTotalLinhas As Long
       
        'Caminho aonde será salvo o arquivo
        lsCaminho = InputBox("Caminho e nome do arquivo:                              Exemplo-  C:ARQUIVO_APB ", "Caminho do arquivo", ActName) & ".txt"

        'Identifica se o arquivo já existe
        If Dir(lsCaminho) = "" Then
            llArquivo = FreeFile
           
            Open lsCaminho For Output As #llArquivo
           
            'Filtra pelos Valores Unicos, sem repetição
            ActiveSheet.Columns("A:A").AdvancedFilter _
                        Action:=xlFilterInPlace, _
                        CriteriaRange:=Range("A1"), Unique:=True
            Range("A1").Activate
           
            Selection.End(xlDown).Select
            iTotalLinhas = Cells(Rows.Count, 1).End(xlUp).Row
            While lContador < iTotalLinhas
                lContador = lContador + 1
                
                'Escreve os dados no arquivo
                Print #llArquivo, Cells(lContador, 1)
               
            Wend
           
            MsgBox "Arquivo Salvo em: " & lsCaminho
            
            'Desfaz o Filtro
            ActiveSheet.ShowAllData
           
            'Fecha o arquivo
            Close #llArquivo
        Else
            MsgBox "Arquivo já existe!"
        End If

    'Tratamento de erro
Sair:
        Exit Sub
TratarErro:
        MsgBox "Houve um erro na gravação do arquivo!"
        GoTo Sair
        Resume
    End Sub

[]s

Obrigada!!
As duas soluções me atendeu =)