Visual Basic VBA - Não cria a tabela dinâmica com todas as linhas.

Fernando da Silveira Gomes · 21 de agosto de 2019

Olá Pessoal,

Gostaria de saber se alguém consegui me ajudar, eu criei o código abaixo:

Sub MACRO3()
Application.ScreenUpdating = False



    ChDir "G:\"
    Workbooks.OpenText Filename:="G:\CONSULTA.txt", Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False, _
        Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
        3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10 _
        , 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
        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, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), _
        Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), Array(35, 1), Array( _
        36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array(42, 1)) _
        , TrailingMinusNumbers:=True
    Cells.Select
    Selection.AutoFilter
    Range("T1").Select
    ActiveSheet.Range("$A$1:$AP$9490").AutoFilter Field:=20, Criteria1:=Array( _
        "LOJINHA", "LO JINHA", "L OJINHA"), Operator:= _
        xlFilterValues
    Range("T1014").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$AP$9490").AutoFilter Field:=20
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveWorkbook.Names.Add Name:="Dados", RefersToR1C1:= _
        "=CONSULTA!R1C2:R9490C42"
    ActiveWorkbook.Names("Dados").Comment = ""
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "dados", Version:=xlPivotTableVersion14).CreatePivotTable TableDestination _
        :="Plan1!R3C1", TableName:="Tabela dinâmica1", DefaultVersion:= _
        xlPivotTableVersion14
    Sheets("Plan1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("Tabela dinâmica1").PivotFields("Lote")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tabela dinâmica1").PivotFields( _
        "RazÃ£o Social Credor")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Tabela dinâmica1").AddDataField ActiveSheet. _
        PivotTables("Tabela dinâmica1").PivotFields("Razao Social Emissor"), _
        "Contagem de Razao Social Emissor", xlCount
    ActiveSheet.PivotTables("Tabela dinâmica1").CompactLayoutRowHeader = "EMISSOR*"
    Range("B3").Select
    ActiveSheet.PivotTables("Tabela dinâmica1").DataPivotField.PivotItems( _
        "Contagem de Razao Social Emissor").Caption = "QUANTIDADE*"
    Range("A3").Select
    ActiveSheet.PivotTables("Tabela dinâmica1").TableStyle2 = "PivotStyleDark6"
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Selection.ColumnWidth = 1.86
    Range("B3:C12").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("C3:C12").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B12").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Sheets("Plan1").Select
    Sheets("Plan1").Name = "DIN"
    ActiveWorkbook.ShowPivotTableFieldList = False
    Sheets("CONSULTA").Select
    ActiveWindow.SmallScroll ToRight:=1
    Range("AE1").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A1").Select
    Sheets("DIN").Select
    ActiveWindow.DisplayGridlines = False
    ChDir "G:\"
    ActiveWorkbook.SaveAs "G:\" & Format(Date, "yyyy.mm.dd") & " " & "CARTEIRA" & ".xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

Application.ScreenUpdating = True
End Sub>

Estou tentando deixar deixa com que o VBA pegue todas as linhas que existem dados. Porque o .txt aumenta e diminui as linhas.

Só que fica dando depurando na parte em negrito e não faço ideia do que eu esteja fazendo de errado.

Se alguém conseguir me ajudar.

Abraços.