Insertar columnas en los números faltantes horizontalmente en un rango

Necesito vuestra valiosa ayuda para que el siguiente macro inserte columnas en los números faltantes horizontalmente (en una fila) de un rango seleccionado.

Lo que sucede es que el siguiente macro no inserta las columnas cuando cuando hay otros rangos adyacentes en el lado izquierdo o derecho del rango seleccionado.

Sub InsertValueBetween3() 'TOV MEOD
'Link: https://www.extendoffice.com/documents/excel/1283-excel-insert-missing-numbers-in-sequence.html#a2
'How To Insert Numbers Or Rows For Missing Sequential Numbers In Excel?

'Updateby Extendoffice
Dim WorkRng As Range
Dim rng As Range
Dim outArr As Variant
Dim dic As Variant
Set dic = CreateObject("Scripting.Dictionary")
Dim FirstCol As Integer
Dim LastCol As Integer
Dim FirstColLetter As String
Dim LastColLetter As String

'On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

'num1 = WorkRng.Range("A1").Value
FirstCol = Cells(6, 1).Column
FirstColLetter = Split(Cells(1, FirstCol).Address, "$")(1)
'MsgBox "FirstCol: " & FirstCol
'num2 = WorkRng.Range("A" & WorkRng.Rows.Count).Value
'num2 = WorkRng.Range(1, Columns.Count).End(xlToLeft).Value
LastCol = Cells(6, Columns.Count).End(xlToLeft).Column
LastColLetter = Split(Cells(1, LastCol).Address, "$")(1)
MsgBox "LastCol: " & LastCol
MsgBox "FirstColLetter: " & FirstColLetter
MsgBox "LastColLetter: " & LastColLetter

num1 = FirstCol
num2 = LastCol - 1

MsgBox "num1: " & num1
MsgBox "num2: " & num2

interval = num2 - num1

MsgBox "interval: " & interval

ReDim outArr(1 To 2, 1 To interval + 1)

For Each rng In WorkRng
dic(rng.Value) = rng.Offset(1, 1).Value
Next

For i = 0 To interval
outArr(1, i + 1) = i + num1
If dic.Exists(i + num1) Then
outArr(2, i + 1) = dic(i + num1)
Else
outArr(2, i + 1) = ""
End If
Next

With WorkRng.Range("A1").Resize(UBound(outArr, 1), UBound(outArr, 2))
.Value = outArr
'.Font.Color = RGB(255, 0, 0)
.Select
End With

End Sub

¿Qué estaré haciendo mal que no inserta las columnas?

Insertar columnas en los números faltantes horizontalmente en un rango

Añade tu respuesta

Haz clic para o