Eu nao entendi direito mas tenta isso

Sub Inserir()

    Selection.EntireRow.Insert
    Selection.EntireColumn.Insert

End Sub

Então, esse código alargaria o retângulo já existente. Eu precisaria inserir um retângulo dentro do já existente, porém, com um tamanho menor. Essa macro precisaria ser utilizada de maneira livre para que quantos retângulos pudessem ser criados conforme a necessidade, entende? Obrigado pela ajuda!!

Complicou....

Eu tbm não entendi muito bem, mas veja se é isso. Considerei que o quadrado ou retângulo é formado através de bordas e que a célula ativa vai estar dentro do quadrado no momento de inserir outros quadrados menores.

Abrçs!

Sub Inserir_QuadRet()
On Error Resume Next
'altura do quadrado ou retângulo
For a = 0 To 100
   If ActiveCell.Offset(-a, 0).Borders(xlEdgeTop).LineStyle = xlContinuous Then
   a = ActiveCell.Offset(-a, 0).Row
   Exit For
   End If
Next a
For b = 0 To 100
   If ActiveCell.Offset(b, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous Then
   b = ActiveCell.Offset(b, 0).Row
   Exit For
   End If
Next b
'cumprimento do quadrado ou retângulo
For r = 0 To 100
   If ActiveCell.Offset(0, r).Borders(xlEdgeRight).LineStyle = xlContinuous Then
   r = ActiveCell.Offset(0, r).Column
   Exit For
   End If
Next r
For l = 1 To 100
   If ActiveCell.Offset(0, -l).Borders(xlEdgeRight).LineStyle = xlContinuous Then
   l = ActiveCell.Offset(0, -l + 1).Column
   Exit For
   End If
Next l
Range(Cells(a + 1, l + 1), Cells(b - 1, r - 1)).Borders(xlEdgeTop).LineStyle = xlContinuous
Range(Cells(a + 1, l + 1), Cells(b - 1, r - 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range(Cells(a + 1, l + 1), Cells(b - 1, r - 1)).Borders(xlEdgeRight).LineStyle = xlContinuous
Range(Cells(a + 1, l + 1), Cells(b - 1, r - 1)).Borders(xlEdgeLeft).LineStyle = xlContinuous
End Sub