Selecionar ate ultima preenchida e salvar como TXT [RESOLVIDO]

[LuizFeijo]

olá amigos, tenho uma planilha de importação de arquivo retorno bancário, já tenho o código de importar as linhas de dentro do arquivo junto a um formulário simples,- aperto um botão, escolho o arquivo, e já importo-.
ao realizar essa importação, a planilha lê os nomes dos clientes e vincula um codigo oriundo do meu sistema contabil á esse cliente, além de valores e numeros de duplicatas. Após essa vinculação, vou na planilha "LAYOUT"
(onde esta formatado o padrão do meu sistema contábil) na coluna "Q", a partir da célula "Q1" descendo ( por exemplo Q1,Q2,Q3...). nessas células utilizei a formula =CONCATENAR(TEXTO(A4;"00");TEXTO(B4;"0000000");TEXTO(C4;"0000000");TEXTO(D4;"0000000");TEXTO(E4;"000000000000000");TEXTO(F4;"0000000");TEXTO(G4;"0000000");TEXTO(H4;"000000");CONCATENAR(I4;J4)), para ir concatenando as variáveis de valores, juros, descontos, código de clientes.... e apliquei a formula para toda coluna. o que preciso é que o vba selecione as células da coluna "Q" a partir de ''Q1" até a ultima preenchida, e depois salve a copia desses dados em um arquivo .TXT

Exemplo:
"Q1">0100001690882557600010822/10/201822/10/2018N0100000018
"Q2">020000001V22/10/2018
"Q3">030000002000118000000000000000061393850000000VALOR REFERENTE A RECEBIMENTO DE CLIENTE CONF.
"Q4">030000003000037100000000000000000000000000000VALOR REFERENTE DESCONTO CLIENTES
"Q5">030000004000000000004330000000000260660000000VALOR REFERENTE A RECEBIMENTO JUROS CLIENTES
"Q6">030000005000000000195200000000005352200000000VALOR REFERENTE A RECEBIMENTO DE CLIENTE CONF.

há um problema, já utilizei um código e ele encontrava, só que na hora de salvar como txt ele só salvava assim #REF
#REF
#REF
#REF...

se alguém souber um modo de me ajudar, muito grato
segue anexo da planilha.

[Reinaldo]

Veja se auxilia.

Seu modelo Ja possui uma rotina que efetua a copia de uma range selecionada, veja se a alteração lhe atende:

Código: Selecionar todos

Sub ExportRangetoFile()
'Update 20130913
Dim wb As Workbook
Dim saveFile As String
Dim WorkRng As Range

On Error Resume Next
xTitleId = "KutoolsforExcel"

Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb = Application.Workbooks.Add
WorkRng.Copy
wb.Worksheets(1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
saveFile = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt), *.txt")
wb.SaveAs Filename:=saveFile, FileFormat:=xlText, CreateBackup:=False
wb.Close
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Em adicional : Acrecentei na coluna P da aba Layout um auxiliar para definir ultima linha
incuida a rotina

Código: Selecionar todos

Sub GeraTxt()
Dim uLinha As Integer, Linha As Integer
Dim Dados As String

'Define o local onde o txt será salvo
'Neste exemplo sera salvo no mesmo diretorio da planilha
Caminho = ThisWorkbook.Path & Application.PathSeparator

'Define o nome do arquivo Txt
Arquivo = "Exportar_Excel_pTxt.txt"

'Prepara o arquivo Txt para receber dados
Open Caminho & Arquivo For Output As #1

Worksheets("LAYOUT").Activate
Range("Q1").Select
Linha = 1
uLinha = Application.WorksheetFunction.Max(Range("P1:P2000"))

For Linha = 1 To uLinha
        Dados = Cells(Linha, "Q")
    Print #1, Dados
Loop
Close #1
End Sub

[LuizFeijo]

obrigado reinaldo, copiei o código e substitui pelo que eu tinha, ei apertei o play, e deu "erro de compilação: variável não definida!" o que pode ter ocorrido?

[Reinaldo]

Na pressa postei os códigos juntos, se copiou do fórum certamente vai dar erro pois Quando o modulo que contem a rotina inicia com : --> Option Explicit
Obriga que todas as variáveis devem ser declaradas.
Corrigi a postagem anterior tente novamente, mas as rotinas tambem se encontram no arquivo anexo

[LuizFeijo]

ola Sr reinaldo, inseri um novo modulo e copiei a rotina corrigida, agora deu outro erro>>> "erro de compilação "loop sem Do". <acredito que seja o inicio do loop -do while-
O que o senhor quis dizer com "mas as rotinas também se encontram no arquivo anexo"?

[Reinaldo]

No mesmo tópico onde estão as rotinas está o seu modelo com as mesma, porem creio que o erro do loop tambem.
Desculpe, com a correria não testei nenhuma delas
Altere no trecho abaixo onde consta Loop-->

Código: Selecionar todos

For Linha = 1 To uLinha
        Dados = Cells(Linha, "Q")
    Print #1, Dados
Loop

Para: Next-->

Código: Selecionar todos

For Linha = 1 To uLinha
        Dados = Cells(Linha, "Q")
    Print #1, Dados
Next

[LuizFeijo]

Bom dia Sr reinaldo, desculpe lhe incomodar tanto ,eu codigo esta assim:
Sub ExportRangetoFile()
'Update 20130913
Dim wb As Workbook
Dim saveFile As String
Dim WorkRng As Range

On Error Resume Next
xTitleId = "KutoolsforExcel"

Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Application.Workbooks.Add
WorkRng.Copy
wb.Worksheets(1).Paste
saveFile = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt), *.txt")
wb.SaveAs Filename:=saveFile, FileFormat:=xlText, CreateBackup:=False
wb.Close
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub GeraTxt()
Dim uLinha As Integer, Linha As Integer
Dim Dados As String

'Define o local onde o txt será salvo
'Neste exemplo sera salvo no mesmo diretorio da planilha
Caminho = ThisWorkbook.Path & Application.PathSeparator

'Define o nome do arquivo Txt
Arquivo = "Exportar_Excel_pTxt.txt"

'Prepara o arquivo Txt para receber dados
Open Caminho & Arquivo For Output As #1

Worksheets("LAYOUT").Activate
Range("Q1").Select
Linha = 1
uLinha = Application.WorksheetFunction.Max(Range("P1:P2000"))

For Linha = 1 To uLinha
Dados = Cells(Linha, "Q")
Print #1, Dados
Next
Close #1
End Sub

só que agora aparece erro em tempo de execuçao 13: Tipos incompativeis
e fica em amarelo no comando "Dados = Cells(Linha, "Q")"

[Reinaldo]

Lembrando:
São duas as rotinas:
"ExportRangetoFile" -- essa já se encontrava em seu modelo, porem você havia dito que não salvada dados

há um problema, já utilizei um código e ele encontrava, só que na hora de salvar como txt ele só salvava assim #REF

Alterei para salvar dados, porem não posso testar pois não tenho o add-in -->"KutoolsforExcel"<--

Na outra rotina:
"GeraTxt"; em seu modelo enviado anteriormente roda normalmente, e gera o arquivo

Exportar_Excel_pTxt.zip

(1.64 KiB) Baixado 213 vezes

Deve ser algo em seu arquivo, mas não sei dizer o que.

[LuizFeijo]

Olá Sr reinaldo, eu baixei o arquivo posto em anexo do txt, é exatamente desse modo que preciso que os dados sejam salvos.

copiei sua rotina em um novo modulo, mais continua dizendo"tipos incompativeis" quando aciono depurar, ele marca "Dados = Cells(Linha, "Q")" como o provavel erro/fica em amarelo. eu copiei a rotina do jeito q esta no meu modulo, podes verificar se eu errei algo?

Sub GeraTxt()
Dim uLinha As Integer, Linha As Integer
Dim Dados As String

'Define o local onde o txt será salvo
'Neste exemplo sera salvo no mesmo diretorio da planilha
Caminho = ThisWorkbook.Path & Application.PathSeparator

'Define o nome do arquivo Txt
Arquivo = "Exportar_Excel_pTxt.txt"

'Prepara o arquivo Txt para receber dados
Open Caminho & Arquivo For Output As #1

Worksheets("LAYOUT").Activate
Range("Q1").Select
Linha = 1
uLinha = Application.WorksheetFunction.Max(Range("P1:P2000"))

For Linha = 1 To uLinha
Dados = Cells(Linha, "Q")
Print #1, Dados
Next
Close #1
End Sub

[Reinaldo]

Voce verificou que inclui uma coluna auxiliar em seu modelo/exemplo (coluna P), para determinar a ultima utilizavel; talvez seja esse o erro reportado.
Experimente a rotina alterada abaixo:

Código: Selecionar todos

Sub GeraTxt()
Dim uLinha As Integer, Linha As Integer
Dim Dados As String, Caminho As String, Arquivo As String

'Define o local onde o txt será salvo
'Neste exemplo sera salvo no mesmo diretorio da planilha
Caminho = ThisWorkbook.Path & Application.PathSeparator

'Define o nome do arquivo Txt
Arquivo = "Exportar_Excel_pTxt.txt"

'Prepara o arquivo Txt para receber dados
Open Caminho & Arquivo For Output As #1

Worksheets("LAYOUT").Activate
Range("Q1").Select
Linha = 1
Do While Range("Q" & Linha) <> ""
    Dados = Cells(Linha, "Q")
    Print #1, Dados
    Linha = Linha + 1
Loop
Close #1
End Sub