Ir ao conteúdo
  • Cadastre-se

Excel Retirar ultima linha em branco de txt criado por VBA


Posts recomendados

Bom dia a todos, estou com o seguinte problema:

Tenho uma planilha que possui dados a partir da linha 8, fiz uma macro que gera um txt com os dados que estiverem a partir da linha 8 e ela funciona muito bem, porém o txt gerado fica com a ultima linha em branco. Eu gostaria que essa macro deixasse no txt apenas as linhas que possuirem valores.

 

 

Segue macro

Sub TXT_Contabil()

Application.ScreenUpdating = False

Dim DIR As String
Dim UltLin
Dim i
Dim LinExp
Dim Separador As String

'FORMULAS
Range("A8").Select
   ActiveCell.FormulaR1C1 = "=REPT(""0"",14-LEN(IF(RC[3]="""","""",ROUND(RC[5]*100,0))))&IF(RC[3]="""","""",ROUND(RC[5]*100,0))"
    Range("B8").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[2]="""","""",CONCATENATE(REPT(""0"",2-LEN(DAY(RC[3]))),DAY(RC[3]),REPT(""0"",2-LEN(MONTH(RC[3]))),MONTH(RC[3]),REPT(""0"",4-LEN(YEAR(RC[3]))),YEAR(RC[3])))"
    Range("C8").Select
    ActiveCell.FormulaR1C1 = "=REPT("" "",120-LEN(RC[8]))"
    Range("A8:c8").Select
    Selection.Copy
    Range("d7").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -1).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    
    Range("a7").Select
    ActiveCell.FormulaR1C1 = "VALOR"
    Range("b7").Select
    ActiveCell.FormulaR1C1 = "DATA"
    Range("c7").Select
    ActiveCell.FormulaR1C1 = "ESP. HIST."
    Range("A7:c7").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.349986266670736
        .PatternTintAndShade = 0
    Selection.Font.Bold = True
    End With
    
'Ordenar Filial e data
    Range("K8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
'    Range(Selection, Selection.End(xlToLeft)).Select
    
    ActiveWorkbook.Worksheets("Contabil").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Contabil").Sort.SortFields.Add Key:=Range("D8:D1048576" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Contabil").Sort.SortFields.Add Key:=Range("E8:E1048576" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Contabil").Sort
        .SetRange Range("A8:k1048576")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'COMEÇO GERAR TXT

'Determina o tamanho da planilha (considerando que a coluna "A" esta preenchida.
UltLin = Cells(Cells.Rows.Count, "A").End(xlUp).Row
'Diretorios para salvar a planilha
DIR = Range("L2") & Range("N4") & Range("M2") & Range("N2")
Separador = Range("O2")

'Abre o arquivo Saida na "Area de Trabalho" do usuario "Local"
'Open "C:\txt\001.txt" For Output As #1
Open DIR For Output As #1
'Workbooks.OpenText Filename:=( For Output As #1

'Executa um loop da linha 8 até a ultima linha de dados

For i = 8 To UltLin
' Monta a linha
LinExp = Left(Cells(i, 30), 1)  'Matriz
LinExp = LinExp & "     "           'Espaços iniciais
LinExp = LinExp & "" & Left(Cells(i, 4), 7) & "008"          'E5_FILIAL
LinExp = LinExp & Separador & Left(Cells(i, 2), 8)  'E5_DATA
LinExp = LinExp & Separador & Left(Cells(i, 1), 16) 'E5_VALOR

If Left(Cells(i, 7), 10) = "" Then
LinExp = LinExp & Separador & "          "   'E5_CONTADEBITO vazia
Else
LinExp = LinExp & Separador & Left(Cells(i, 7), 10)   'E5_CONTADEBITO
End If

If Left(Cells(i, 8), 10) = "" Then
LinExp = LinExp & Separador & "          "   'E5_CONTACREDITO vazia
Else
LinExp = LinExp & Separador & Left(Cells(i, 8), 10)   'E5_CONTACREDITO
End If

If Left(Cells(i, 9), 9) = "" Then
LinExp = LinExp & Separador & "         "   'E5_CCD vazio
Else
LinExp = LinExp & Separador & Left(Cells(i, 9), 9)   'E5_CCD
End If

If Left(Cells(i, 10), 9) = "" Then
LinExp = LinExp & Separador & "         "   'E5_CCC vazio
Else
LinExp = LinExp & Separador & Left(Cells(i, 10), 9)   'E5_CCC
End If

LinExp = LinExp & Separador & Left(Cells(i, 11), 120) & Left(Cells(i, 3), 120) 'E5_HISTOR"

' Grava a linha no arquivo
Print #1, LinExp

Next i

'Fecha o arquivo
Close #1

MsgBox ("Arquivo salvo com sucesso na pasta: " & DIR)

Application.ScreenUpdating = True

End Sub

AMORT_Distrib Resultado.txt

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...