How to identify the last row of a VBA formatted table

Question

Personally I have a seemingly simple problem: I have to identify the first empty row of a table, but this table received a formatting of the excel itself "Format as tables". When I ask to identify the first empty line, the code understands that it is below the "Formatted Table". I need him to identify line 9, but he’s identifying line 49 as last empty

Follow the code below:

Dim Base        As Worksheet 'Planilha principal
Dim WS          As Worksheet 'Planilha secundária
Dim sht         As Worksheet 'Manipular as novas planilhas

Dim Encont      As Boolean 'Verifica se uma planilha foi encontrada ou não

Dim ln          As Long 'Controle das linhas da planilha principal
Dim lnTemp      As LongLong 'Controle das linhas da planilha secundária

Dim col         As Integer 'Controle das colunas da planilha principal
Dim colTemp     As Integer 'controle das colunas da planilha secundária
Dim qtd         As Integer 'Quantidade de engenheiros
Dim a           As Integer 'controle de loop

Dim rng         As Range 'Mapearmos as células para classificação dos dados
Dim ultCel      As Range 'Ultima célula com dados

Dim Nomes()     As Variant 'Array para controlar o nome dos cargos

Application.ScreenUpdating = False


ln = 2 'Na planilha Base a análise começa na linha 2
col = 1
lnTem = 2
colTemp = 1
Encont = False

Set Base = Sheets("Base")

Base.Select
Set ultCel = Base.Cells(Base.Rows.Count, 1).End(xlUp) 'Sei qual a útlima linha com dados

Base.Columns(3).Delete
Base.Range("E:L").Delete



'Passo 1: Classificação
'______________________

Base.Range("D2").Select

Set rng = Base.Range("D2").CurrentRegion

Base.Sort.SortFields.Clear
Base.Sort.SortFields.Add2 Key:=Base.Range("D2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers

With Base.Sort
    .SetRange rng
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Passo 2: Criar uma lista uníca de cargos
'_________________________________________

Set rng = Base.Range("D1:D" & ultCel.Row)

rng.Select
rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Base.Range("F1"), Unique:=True

'Passo 3: Manipulação e checagem das pastas
'____________________________________________

Set ultCel = Base.Cells(Base.Rows.Count, 6).End(xlUp) 'Qual é a última célula dos cargos filtrados
qtd = Application.WorksheetFunction.CountA(Base.Range("F2:F" & ultCel.Row)) 'Conta número de cargos

ReDim Nomes(1 To qtd)  'Redimensiona a Array

ln = 2
col = 6

For a = 1 To qtd

    Nomes(a) = Base.Cells(ln, col)
    ln = ln + 1

Next a

ln = 2
col = 1

'Percorrer as planilhas para verificar se existe ou não uma com o nome do cargo
'_____________________________________________________________________________

For a = 1 To qtd 'Loop para os cargos

For Each sht In Sheets 'Percorra todas as planilhas do conjunto de planilhas (sheets)

    If sht.Name = Nomes(a) Then 'Verifica se a planilha atual é do cargo
                    
        ultsht = sht.Range("A1048576").End(xlUp).Row - 6 'Qual a ultima célula que contem informação (espero que ele considere a formatação como preenchimento)
         
        Encont = True 'Indica que encontrou
        
        sht.Select
        sht.Range(Cells(9, 1), Cells(ultsht, 6)).ClearContents 'Apaga todos os dados
                        
        ultCel2 = Base.Range("A1048576").End(xlUp).Row 'Qual a quantidade de vezes que aparece o nomes dos engenheiros
        
        cargo = Nomes(a)
        
        Base.Select
        
        qtdCarg = WorksheetFunction.CountIf(Base.Range(Cells(2, 4), Cells(ultCel2, 4)), cargo)
        
        sht.Select
        
        If ultsht < qtdCarg Then
    
            Do While ultsht = qtdCarg
            
                sht.Rows(ultsht).Insert
                
                ultsht = ultsht + 1
            
            Loop
        
        End If
    
    Exit For 'Sai do For

    End If
    
Next sht
        If Encont = False Then 'Não encontrou
            Sheets.Add after:=Sheets(Sheets.Count) 'Cria a planilha
            ActiveSheet.Name = Names(a) 'Troca o nome
        End If
Next a
    
'Transferência dos dados
Base.Select
Base.Range("A2").Select

Set ultCel = Base.Cells(Base.Rows.Count, 1).End(xlUp)

**Do While ln <= ultCel.Row 'Percorre todas as linhas para copiar os dados

    Set WS = Sheets(Base.Cells(ln, 4).Value)
    WS.Select
    lnTemp = WS.Cells(WS.Rows.Count, 1).End(xlUp).Offset(1, 0).Row - 40
    Base.Cells(ln, col).Resize(1, 14).Copy Destination:=Sheets(Base.Cells(ln, 4).Value).Cells(lnTemp, colTemp)
   
    ln = ln + 1

Loop**


Application.ScreenUpdating = True
End Sub```

Answer 1

Hello,

You can do it this way:

ultCel = Activesheet.Listobjects("Table1").Range.Rows.Count 'Identifies the last line

I = 2

Do Until ultCel = Empty

If Range("A" & I).Value = Empty Then
   ultCel = Range("A" & I).Row 'Paga a linha vazia
   Exit Do 'Sai do loop
End If    
I = I + 1  

Loop