Cambiar bucle para escribir resultados en celdas adicionales

He estado usando el siguiente código por un tiempo pero necesito ayuda para hacer un cambio. Lo he intentado y lo he intentado, pero no funcionará. Si alguien puede echarle un vistazo, mi investigación dice que estoy buscando un "ciclo de cambio para escribir resultados en celdas adicionales". Por favor, vea mi imagen de Excel a continuación.

En este momento, el código encuentra todos los números coincidentes ingresados ​​en la celda A1 y los publica en las celdas apropiadas L1: l12. Necesito el código para publicar la misma información en solo una de las siguientes celdas: C17, C18, F17, F18. Además, si el código podría copiar y pegar el número en la celda debajo del número correspondiente (de la celda A1), vea el resultado de la muestra a continuación a la izquierda del pegado del bucle de cambio anterior en las siguientes celdas: B17, B18, E17, E18.

Ejemplo con resultado esperado según la muestra de la imagen de Excel. El número 8 se ingresó en la celda A1 y se encontraron 8 en la celda A34. Entonces, 8-15 se copiarían y pegarían a L8 y C17. También copiaría el número 7 de la celda A35 (el siguiente número) a la celda B17. El código también haría lo mismo para las celdas F20 y E21. Después de haber copiado y pegado, todas las celdas B34, C34 y D34 deben eliminarse, por lo que estarán en blanco. Lo mismo para F20, G20 y H20. Espero que esto quede claro, si no, por favor avise y lo aclararé.

Mi código de trabajo está debajo y mi intento está debajo de ese código.

Código de trabajo:

Sub do_it()

    Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range

    Set sht = ActiveSheet

    n = sht.Range("A1")

    For Each cell In sht.Range("A20:A34,D20:D34,G20:G34").Cells

        tmp = cell.Offset(0, 1).Value

        If cell.Value = n And tmp Like "*#-#*" Then

            'get the first number
            num = CLng(Trim(Split(tmp, "-")(0)))
            Debug.Print "Found a positive result in " & cell.Address
 'find the next empty cell in the appropriate row
         Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
            'make sure not to add before col L
            If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)

            cell.Offset(0, 1).Copy rngDest

        End If
    Next

End Sub

Mi intento:

Sub do_it()

    Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range

    Set sht = ActiveSheet

    n = sht.Range("A1")

    For Each cell In sht.Range("A20:A34,D20:D34,G20:G34").Cells

        tmp = cell.Offset(0, 1).Value

        If cell.Value = n And tmp Like "*#-#*" Then

            'get the first number
            num = CLng(Trim(Split(tmp, "-")(0)))
            Debug.Print "Found a positive result in " & cell.Address
 'find the next empty cell in the appropriate row
         Set rngDest = (“ C17, C18, F17, F18’)
             cell.Offset(0, 1).Copy rngDest

        End If
    Next

End Sub

Puede que no sea bonito o escalable, pero como no estoy seguro de lo que está intentando lograr a largo plazo, esto es algo que debería funcionar.

Primero de, la fila For Each cell In sht.Range("A20:A34,D20:D34,G20:G34").Cells no corresponde con las celdas utilizadas en su ejemplo, así que cambié eso a:

For Each cell In sht.Range("A20:A34,E20:E34,I20:I34").Cells

Luego secuestré la variable tmp al final, porque ya no se usa, y la configuré para encontrar la última celda de la columna donde encontró una coincidencia, como la siguiente:

Set tmp = sht.Cells(Cells(Rows.Count, cell.Column).End(xlUp).Row, cell.Column)

Luego debemos especificar los nuevos cuadros y asegurarnos de que solo llenamos cada uno una vez. Puede hacerlo comprobando si el primero está vacío o con un contador. De cualquier manera, solo funcionará correctamente siempre y cuando encuentres menos de 4 coincidencias.

El resultado final fue este, modificar según sea necesario;

Sub do_it()

Dim sht As Worksheet, n As String, cell, num, tmp, rngDest As Range, i As Integer
Set sht = ActiveSheet
n = sht.Range("A1").Value
i = 0
For Each cell In sht.Range("A20:A34,E20:E34,I20:I34").Cells
    tmp = cell.Offset(0, 1).Value
    If cell.Value = n And tmp Like "*#-#*" Then
       'get the first number
        num = CLng(Trim(Split(tmp, "-")(0)))
        'find the next empty cell in the appropriate row
        Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
        'make sure not to add before col L
        If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)
        cell.Offset(0, 1).Copy rngDest

' This is getting the next number in A/E/I----
        Set tmp = cell.Offset(1, 0)

' This is filling up B17 - F18 in order until filled
        If sht.Range("B17").Value = "" Then
            sht.Range("C17").Value = cell.Offset(0, 1).Value
            sht.Range("B17").Value = tmp.Value
        ElseIf sht.Range("B18").Value = "" Then
            sht.Range("C18").Value = cell.Offset(0, 1).Value
            sht.Range("B18").Value = tmp.Value
        ElseIf sht.Range("E17").Value = "" Then
            sht.Range("F17").Value = cell.Offset(0, 1).Value
            sht.Range("E17").Value = tmp.Value
        ElseIf sht.Range("E18").Value = "" Then
            sht.Range("F18").Value = cell.Offset(0, 1).Value
            sht.Range("E18").Value = tmp.Value
        End If
  '---- This clears the BCD/FGH/JKL columns after using the value ----
        'cell.Offset(0, 1).Resize(, 3).Value = ""


   End If
Next cell
End Sub