Alterar loop para gravar resultados em células adicionais

Uso o código a seguir há algum tempo, mas preciso de ajuda para fazer uma alteração. Eu tentei e tentei, mas não vai funcionar. Se alguém puder dar uma olhada, minha pesquisa diz que estou procurando um "loop de alteração para gravar resultados em células adicionais". Por favor, veja minha imagem do Excel abaixo.

No momento, o código localiza todos os números correspondentes inseridos na célula A1 e os lança nas células apropriadas L1: 12. Também preciso do código para postar as mesmas informações em apenas uma das seguintes células: C17, C18, F17, F18. Além disso, se o código puder copiar e colar o número na célula abaixo do número correspondente (da célula A1), consulte o resultado da amostra abaixo) na célula à esquerda do loop de alteração acima, cole nas seguintes células: B17, B18, E17, E18.

Exemplo com resultado esperado conforme a imagem de amostra do Excel. O número 8 foi inserido na célula A1 e encontrado 8 na célula A34. Assim, 8-15 seriam copiados e colados para L8 e C17. Também copiaria o número 7 da célula A35 (o número a seguir) para a célula B17. O código também faria o mesmo para as células F20 e E21. Depois de todo o processo de copiar e colar todas as células B34, C34 e D34 precisam ser excluídas e, portanto, ficam em branco. Mesmo para F20, G20 e H20. Espero que isso esteja claro, se não, por favor, informe e eu vou esclarecer.

Meu código de trabalho está abaixo e minha tentativa está abaixo desse código.

Código de trabalho:

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

Minha tentativa:

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

Pode não ser bonito ou escalável, mas como não tenho certeza exatamente do que você está tentando alcançar a longo prazo, aqui está algo que deve funcionar.

Primeiro, a linha For Each cell In sht.Range("A20:A34,D20:D34,G20:G34").Cellsnão corresponde às células usadas no seu exemplo, então mudei para:

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

Então eu sequestrei a variável tmp no final, porque ela não é mais usada, e configurei-a para encontrar a última célula da coluna onde encontrou uma correspondência, assim:

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

Em seguida, precisamos especificar as novas caixas e certificar-se de preencher apenas uma vez. Você pode fazer isso verificando se o primeiro está vazio ou com um contador. De qualquer forma, ele funcionará corretamente apenas se você encontrar menos de 4 correspondências.

O resultado final foi este, modifique conforme necessário;

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