Bom dia pessoal,
Primeira vez que peço ajuda,
Construi uma macro bonitinha, e depois de rodar algumas vezes, o arquivo sobre para 96mb, e ai trava tudo.
Isso tinha acontecido de inicio quando eu subi 1500xml de uma soh vez, até ai concordo, mas agora, estou reescrevendo a macro (para organizar algumas coisas) e está ocorrendo esse problema.

Outra coisa que eu corrigi na mão (tirei os arquivos um por um) são os arquivos corrompidos, eu não consigo pular o erro -200 e um codigo gigante.
Dei uma googada no codigo e achei somente 3 paginas no assunto,
Mas esse não é urgente,

O que eu preciso mesmo é entender o que está na memoria da minha macro que está criando este mega arquivo,

Desde já obrigado,

Abrcs

'Limpar aba do table generico
Function GetTableName1(IA) As String
    GetTableName = Worksheets("InputAux").ListObjects(1).Name
With Worksheets("InputAux").ListObjects(GetTableName)
    Set rList = .Range
    .Unlist
End With
End Function
_____________________________________________________
Sub ImpInd()

'application.screenupdating = false
Application.DisplayAlerts = False

Dim FTU, IA, Cnslt, CCU As Worksheet
    Set FTU = Worksheets("FileToUpload")
    Set IA = Worksheets("inputAux")
    Set Cnslt = Worksheets("Consulta")
    Set CCU = Worksheets("CompararCheckUnit")

'Dimensionar caminho para selecionar arquivo    
Dim Caminho As String
Dim fDialog As Office.FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
    .AllowMultiSelect = False
    .Title = "Selecionar arquivo..."
    .Filters.Clear
    .Filters.Add "Arquivos Excel - .xml", "*.xml"
        If .Show = True Then
            Caminho = .SelectedItems.Item(1)
        Else
            MsgBox "Você clicou em cancelar"
            Menu.Select
            End
        End If
End With

'aba na qual se cola o caminho do arquivo para futura referencia na hora de abrir
FTU.Select
With ActiveSheet
    .Cells.Delete
    .Range("A1") = Array("Caminho")
Range("A2") = Caminho
End With

Call Importar

'application.screenupdating = True
Application.DisplayAlerts = True

End Sub
_____________________________________________________


Sub Importar()

Dim FTU, IA, Cnslt, CCU, XMLdb As Worksheet
    Set FTU = Worksheets("FileToUpload")
    Set IA = Worksheets("inputAux")
    Set Cnslt = Worksheets("Consulta")
    Set CCU = Worksheets("CompararCheckUnit")
    Set XMLdb = Worksheets("XMLDatabase")

o = 2
FTU.Select
    uArq = Columns(1).End(xlDown).Row

'Loop para abrir arquivo xml, importar, filtrar, corrigir, e transferir de aba
While o <= uArq
    Dim Cam As String
        Cam = FTU.Cells(o, 1)



    IA.Select
        'ActiveSheet.AutoFilterMode = False
'        iUlinha1 = Columns(1).End(xlDown).Row
 '           If iUlinha1 = 3 Then
  '          Range("3:3").Delete
   '         Else
    '        Range("3:" & iUlinha1).EntireRow.Delete
     '   End If

    AbrirArquivo = Cam
    ActiveWorkbook.XmlImport URL:=AbrirArquivo, ImportMap:=Nothing, Overwrite:=True, Destination:=Cells(1, 1)
        Call GetTableName1(IA)

'Filtro para CFOP necessa´ria
Dim bCFOP As Variant
    With IA.Range("1:1")
    Set bCFOP = .Find("ns1:CFOP", LookIn:=xlValues)
    End1 = bCFOP.Column
    End With
ActiveSheet.AutoFilterMode = False
    iULinha2 = Columns(1).End(xlDown).Row
    Range("1:1").AutoFilter field:=End1, Criteria1:=Array("5101", "5124", "5102", "6102", "6101", "6124"), Operator:=xlFilterValues
    
    With IA.Range("1:1")
    Set bnNF = .Find("ns1:nNF", LookIn:=xlValues)
    Set bdhEmi = .Find("ns1:dhEmi", LookIn:=xlValues)
    Set bCNPJ7 = .Find("ns1:CNPJ7", LookIn:=xlValues)
        If bCNPJ7 Is Nothing Then 'Tem XML com CNPJ e outros com CNPJ7?!?!?
            Set bCNPJ7 = .Find("ns1:CNPJ", LookIn:=xlValues)
            Else
        End If
    Set bVenc = .Find("ns1:dVenc", LookIn:=xlValues)
    End2 = bnNF.Column
    End3 = bdhEmi.Column
    End4 = bCNPJ7.Column
    End5 = bVenc.Column
    End With
    
'Espalhar primeira celula nas demais, pois as vezes vem em branco
    Cells(2, End2).Copy
    Range(Cells(2, End2), Cells(iULinha2, End2)).PasteSpecial Paste:=xlPasteFormulas
    Application.CutCopyMode = False
    Cells(2, End3).Copy
    Range(Cells(2, End3), Cells(iULinha2, End3)).PasteSpecial Paste:=xlPasteFormulas
    Application.CutCopyMode = False
    Cells(2, End4).Copy
    Range(Cells(2, End4), Cells(iULinha2, End4)).PasteSpecial Paste:=xlPasteFormulas
    Application.CutCopyMode = False
    Cells(2, End5).Copy
    Range(Cells(2, End5), Cells(iULinha2, End5)).PasteSpecial Paste:=xlPasteFormulas
    Application.CutCopyMode = False

Correcao de CNPJ em No para texto    
            Dim ContCNPJ7 As String
        Dim CelulaCNPJ7 As Range
            Set CelulaCNPJ7 = Cells(2, End4)
        Zero = Cnslt.Range("C2").Value
        ContCNPJ7 = Len(CelulaCNPJ7)
        If ContCNPJ7 = 13 Then
        Busca1 = Zero & CelulaCNPJ7
        ElseIf ContCNPJ7 = 12 Then
        Busca1 = Zero & Zero & CelulaCNPJ7
        ElseIf ContCNPJ7 = 11 Then
        Busca1 = Zero & Zero & Zero & CelulaCNPJ7
        Else
        Busca1 = CelulaCNPJ7
        End If
        IA.Range(Cells(2, End4), Cells(iULinha2, End4)) = Busca1
        Application.CutCopyMode = False
    
'Nessa aba tem as colunas a serem selecionas para copiar para a aba XMLdb
Cnslt.Select
    uCnslt = Columns(1).End(xlDown).Row

j = 2
    
    XMLdb.Select
        uXMLdb = Columns(1).End(xlDown).Row

'Loop para copiar colunas selecionadas na aba XMLdb    
    While j <= uCnslt
    Dim Cnslt1 As Range
        Set Cnslt1 = Cnslt.Cells(j, 1)
    
    IA.Select
        uLinhaIA3 = Columns(1).End(xlDown).Row
        Dim BuscarRef As Variant
        With IA.Range("1:1")
        Set BuscarRef = .Find(Cnslt1, LookIn:=xlValues)
            If BuscarRef Is Nothing Then
                Set BuscarRef = .Find("ns1:CNPJ", LookIn:=xlValues)
                Else
            End If
        EndX = BuscarRef.Column
        End With
        If uLinhaIA3 = 2 Then
            Cells(2, EndX).Copy
            Else
            Range(Cells(2, EndX), Cells(uLinhaIA3, EndX)).SpecialCells(xlCellTypeVisible).Copy
        End If

    XMLdb.Select
            If uXMLdb = 1048576 Then
                uXMLdb = 1
                Else
                End If
        Dim BuscarRef2 As Variant
        With XMLdb.Range("1:1")
        Set BuscarRef2 = .Find(Cnslt1, LookIn:=xlValues)
        EndY = BuscarRef2.Column
        Cells(uXMLdb + 1, EndY).PasteSpecial Paste:=xlPasteFormulas
            Application.CutCopyMode = False
        End With
    j = j + 1
    Wend

'Limpar area de importacao    
    IA.Select
    ActiveSheet.AutoFilterMode = False
    With ActiveSheet
    .Cells.Delete
    End With
    
    
    
o = o + 1

Wend
End Sub