Вставьте дополнительную строку, когда мистер и миссис будут найдены, затем скопируйте данные в пустую строку

Приведенное ниже решение закодировано для ваших трех столбцов, которые должны находиться в столбцах A, B и C. Этот цикл работает снизу ваших данных, чтобы упростить работу со вставленной строкой.

Sub split_rows()
    Dim s As Worksheet
    Dim r As Long
    Dim title_position As Integer
    Dim saluation_position As Integer
    Dim title As String
    Dim salutation As String
    Dim last_row As Long
    
    Const name_column = 1
    Const title_column = 2
    Const salutation_column = 3
    
    
    Set s = ActiveSheet 'use the line to process the active sheet
    'set s = worksheets("Sheet1") ' use this line to process a specific sheet
    
    ' this loop works from the bottom of the worksheet up.
    ' the code is simpler that working top-down.
    last_row = s.Cells(s.Rows.Count, title_column).End(xlUp).Row
    For r = last_row To 2 Step -1
        Debug.Print s.Cells(r, 1).Value
        title_position = InStr(1, s.Cells(r, title_column).Value, "&")
        saluation_position = InStr(1, s.Cells(r, salutation_column).Value, "&")
          
        If title_position > 0 And saluation_position > 0 Then
            ' found ampersands in title and salution, let's to split the data
            
            'put joint title and salutation values in variables to make the code easier to read
            title = s.Cells(r, title_column).Value
            salutation = s.Cells(r, salutation_column).Value
            
            s.Rows(r).Insert  ' add a row
            
            ' put the the name (unchanged) in the new row
            s.Cells(r, name_column).Value = s.Cells(r + 1, name_column).Value
            
            ' put half the title in each row
            s.Cells(r, title_column).Value = Trim(Split(title, "&")(0))
            s.Cells(r + 1, title_column).Value = Trim(Split(title, "&")(1))
            
            ' put half the salutation in each row
            s.Cells(r, salutation_column).Value = Trim(Split(salutation, "&")(0))
            s.Cells(r + 1, salutation_column).Value = Trim(Split(salutation, "&")(1))
      End If
    Next


End Sub