Excel VBA循环查找特定范围并连接2个单元格值并删除空单元格

Question

I am trying to identify a specific range in column-A and concatenate two cells within the specific range and delete the empty cell. I have been successful in putting a code together and it does the job very well. But, I don't know how to loop it to identify next range. Any help would be appreciated.

As per below image and code, First, I am finding and selecting a range between two (MCS) in column-A with a condition that, if the rows are more than 8 between two MCS. Then I am concatenating first 2 cells immediately after MCS and delete the empty row.

The below code works well for first range but I am unable to loop to identify next range from row 22 to 32 and perform concatenations.

I dont know how to loop in column-A and select ranges and concatenate. Any help would be much appreciated. Thanks

Sub MergeStem()
    Dim findMCS1 As Long
    Dim findMCS2 As Long
    Dim myCount As Integer
    Dim myStems As Long
    Dim mySelect As Range
    Dim c As Range

    findMCS1 = Range("A:A").Find("MCS", Range("A1")).Row
    findMCS2 = Range("A:A").Find("MCS", Range("A" & findMCS1)).Row

    myCount = Range("A" & findMCS1 + 1 & ":A" & findMCS2 - 1).Cells.Count
    Range("B1").Value = myCount
    MsgBox "Number of rows =" & myCount

    Set mySelect = Selection

    If myCount > 8 Then
        myStems = Range("A" & findMCS1 + 2 & ":A" & findMCS2 - 9).Select

        Set mySelect = Selection

        For Each c In mySelect.Cells
            If firstcell = "" Then firstcell = c.Address(bRow, bCol)
            sArgs = sArgs + c.Text + " "

            c.Value = ""
        Next
        Range(firstcell).Value = sArgs
    End If

    Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    Application.ScreenUpdating = True

End Sub

Answer 1

Can you try this? Ordinarily, Find would be the way to go but because you are deleting rows it's hard to keep track of which cells you've found.

Sub x()

Dim r As Long, n1 As Long, n2 As Long

With Range("A1", Range("A" & Rows.Count).End(xlUp))
    For r = .Count To 1 Step -1
        If .Cells(r).Value = "MCS" Then
            If n1 = 0 Then
                n1 = .Cells(r).Row
            Else
                n2 = .Cells(r).Row
            End If
            If n1 > 0 And n2 > 0 Then
                If n1 - n2 > 9 Then
                    .Cells(r + 1).Value = .Cells(r + 1).Value & .Cells(r + 2).Value
                    '.Cells(r + 2).EntireRow.Delete
                    'Call procedure to delete row 
                End If
                n1 = n2
                n2 = 0
            End If
        End If
    Next r
End With

End Sub