Como fazer a macro parar na ultima linha da planilha

Bom dia Pessoal!

Eu tenho uma macro que importa imagens de uma pasta especifica de acordo com a referencia dela. Por exemplo: Na coluna A2 tem uma referencia chamada Maca e na pasta X da área de trabalho ele busca a imagem Maca e posiciona na célula num tamanho especifico. Porém essa macro está em looping infinito sem parar, não consigo faze-la parar onde eu incluiria o código para isso?

Muito Obrigado

MACRO:
Sub Incluir_Imagens()

Dim Worksheet(1) As PivotTable

Resultado = MsgBox(“inicar a inclusão de imagens?”, vbYesNo, “Atualizar”)

If Resultado = vbYes Then

Application.ScreenUpdating = False

'EXCLUINDO IMAGENS

Dim DrObj
Dim Pict
Set DrObj = ActiveSheet.DrawingObjects
For Each Pict In DrObj
If Left(Pict.Name, 7) = "Picture" Then
Pict.Select
Pict.Delete
End If
Next

'incluindo Imagens

Cells.Select
Cells.EntireRow.AutoFit
    Rows("1:10").EntireRow.AutoFit
    Selection.Find(what:="PRODUTOCOR").Select
    SEMERRO = "SIM"
    
Do While ActiveCell <> "-"
    
    CHAVE = ActiveCell.Value
    LIN = ActiveCell.Row
    COL = ActiveCell.Column
    ActiveCell.Offset(0, 0).Range("a1").Select
    Selection.RowHeight = 53.25
        
        Dim cellleft As Single
        Dim celltop As Single
        Dim cellwidth As Single
        Dim cellheight As Single
    
            cellleft = Selection.Left
            celltop = Selection.Top
            
On Error GoTo COMERRO
    
ActiveSheet.Shapes.AddPicture("C:\Users\vfreitas\Desktop\SS 2021\" + CHAVE + ".jpg", False, True, cellleft, celltop, -1, -1).Select

REINICIAR:

    If SEMERRO = "SIM" Then
    
    If Selection.ShapeRange.Width >= 79 Then
        Selection.ShapeRange.Width = 79
        ElseIf Selection.ShapeRange.Height >= 45 Then
    End If
        Selection.ShapeRange.Rotation = 0#
        Selection.ShapeRange.IncrementTop 1.95
    End If
        Cells(LIN, COL).Select
        ActiveCell.Offset(1, 0).Range("A1").Select
        SEMERRO = "SIM"
        
    Loop
    
    Rows("10:10").EntireRow.AutoFit
    
    Range("A1").Select
    ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).Select
    With Selection.ColumnWidth = 6.5
    End With
    
    With ActiveSheet.PivotTables(1).TableRange2
        .Cells(.Cells.Count).Select
        ActiveCell.Offset(-1, -1).Select
    End With
        Range(Selection, Cells(1)).Select
            ActiveSheet.PageSetup.PrintArea = Selection.Address
            
            ActiveSheet.PivotTables(1).PivotSelect "PRODUTOCOR.[ALL;'Blank']", _
                xlDataAndLabel, True
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        
        
        TABDIN.TableRange1.Select
            With Selection
            .VerticalAlignment = xlCenter
        End With
        
        TABDIN.DataBodyRange.Select
            With Selection
            .HorizontalAlignment = xlCenter
        End With
        
        TABDIN.ColumnRange.Select
        With Selection
            .HorizontalAlignment = xlCenter
            .Borders(xlLeft).LineStyle = xlContinuous
            .Borders(xlLeft).Weight = xlThin
            .Borders(xlRight).LineStyle = xlContinuous
            .Borders(xlRight).Weight = xlThin
        End With
        
        TABDIN.TableRange1.Select
        With Selection
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    
        ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
        
        Range("a1:a3").Select
        Selection.EntireRow.AutoFit
        
        Range("a1").Select
        
        'Incluir Bordas

TABDIN.DataBodyRange.Select
    With Selection
    .ColumnWidth = 5.85
    .Borders(xlLeft).LineStyle = xlContinuous
    .Borders(xlLeft).Weight = xlThin
    .Borders(xlRight).LineStyle = xlContinuous
    .Borders(xlRight).Weight = xlThin
End With

'FORMATAÇÃO CONDICIONAL PARA QUANTIDADES ZERADAS (PRETO)

 Selection.NumberFormat = "#,##0"

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
    Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
End With

        
    
        MsgBox ("Atualização efetuada com sucesso!!!")
        
        Exit Sub

COMERRO:

SEMERRO = "NÃO"
ActiveCell.RowHeight = 20
ActiveCell.EntireRow.ClearFormats
Resume Next
GoTo REINICIAR

Else

MsgBox "Atualização cancelada", vbOKOnly, "Incluir Imagens"

End If
Exit Sub

End Sub