VBA Find and replace loop help needed

I need to add a section within an existing macro that takes a cell's address and looks for that address (as a string?) from the values within a range of cells - then offsets one column over to use that new value to replace its original value. I cannot hard code the cells in my mCell range, but also cannot figure out a functional loop that successfully moves through my mCell range and finds/replaces using values from another part of the worksheet. I'm new at VBA and keep getting errors and wind up defining a dozen ranges and strings trying to carry over the data. Any help would be greatly appreciated!

My code is looking for unmerged cells, and when it finds an unmerged cell, it needs to grab the correct value to put in there. Not all cells in my range mCell are unmerged, so this is a find/replace within a loop.

For example:
if unmerged mCell.address = "B20", then the macro finds the value "B20" in a designated range (in example below, was found in cell Q20), then offset one column over (to cell R20), then uses value of that cell (which is 6) to replace the value of mcell, such that the cell value of B20 (i.e., the active mCell) = 6. Then on to the next unmerged mCell...
row Column Q Col. R
18 B18(text) 5
19 B19 4
20 B20 6
21 B21 3


My existing code is: (simplified spreadsheet also attached that illustrates how the find/replace works)

'******************** This Sub will activate when the sheet is opened**********************************
' This sub looks for the word "Table" in column A.  If the word appears, it unmerges the cells in columns B - E
' and the rows following to allow for the insert of a table, then merges all other rows for sake of format.

Option Explicit
Private Sub Worksheet_Activate()
  
 Application.ScreenUpdating = False
 
  Range("B14:E64").SpecialCells(xlCellTypeVisible).Select
  With Selection
  .RowHeight = 17
  .VerticalAlignment = xlTop
  .HorizontalAlignment = xlLeft
  .WrapText = True
  End With
  
 
  
  '*******Merge or unmerge rows according to whether or not they contain Table data -
  ' this only acts on visible cells, so rows of data table can be hidden as needed
  
  
    Dim TA As Integer
    Dim ColValues As Variant
    Dim rng As Range
    Dim tabNo As Range                    'uses value on worksheet to know how many rows to unmerge
  
  '*******Dims in finding and replacing unmerged cell values
   
    Dim mergeRange As Range             'Range B16:E64 - where my mCells are being pulled from
    Dim mCell As Range                  'Cell that is unmerged, looking for its address
    Dim ws As Worksheet
    Dim tabledata As Range              'Range Q11:Q38 - this is the column I'm searching in and offsetting from
    Dim aCell As String                 'picks up cell address, to use in .find
    Dim myCell As Range                 'cell address in Q
    Dim ReplaceString As String
    Dim foundCell As Range
    Dim bCell As Range
    Dim i As Long
    
    

    
    

Application.DisplayAlerts = False

'Make column B = Column A values, cannot make this happen on sheet, because data is too variable

 ColValues = ActiveSheet.Range("A16:A64").Value
 ActiveSheet.Range("B16:B64").Value = ColValues
 
 'Look for data table, if not present, merge cells
 Set rng = ActiveSheet.Range("B14:B100")
 Set tabNo = ActiveSheet.Range("K6")

 
  For TA = 15 To 64                     'defines TA variable to loop from row 14 to row 64
  
  If Cells(TA, "A") = "Table" Then      '***NEED TO CLEAR ALL "NA" CELL ERRORS OR CODE DOES NOT RUN - lookS for word "Table" in column A, active range of the report

  Range("B" & TA & ":E" & TA + tabNo).UnMerge   'unmerges the row with "Table" listed and the next 7 rows (to make a 8-row x 4 column unmerged area for table
  TA = TA + tabNo                               ' moves active cell "TA" down 7 spaces
 
  
  Else
  Range("B" & TA & ":E" & TA).Merge         'If "Table" not found, then merge the cells for the row TA is in across columns B:E
  End If
  
  Next TA
  
  
  '*** Part II: Need some calculation to loop or offset or find through data and fill
  'unmerged cells from a data table on the worksheet.
  'the placement of the data table varies depending on the layout of the report,
  'which changes day to day, so can not be hard coded into the cells - needs to look up
  'position of the word "Table" and dump data after that.
  
  'offset? .find? loop?
  
  
  '***want to take the cell address of each unmerged cell within the range of the report
  'and look for that cell in an array, then replace the cell contents with the correct value
  

    Set mergeRange = ActiveSheet.Range("B16:E64")
  
  For Each mCell In mergeRange
       ' If mergeRange.MergeCells = True Then
       ' MsgBox "all cells are merged, exiting sub"
       ' Exit Sub
       'Else
        If mCell.MergeCells = False Then
        
       aCell = mCell.Address      '??? Need to set the cell address as
                                        'a text string or something in order to look for that address in the values
                                      'of cells in range "tabledata"
        
        'MsgBox "aCell " & Range(aCell).Address
                  

        Set tabledata = ActiveSheet.Range("Q11:Q38")
                                  
        Set bCell = tabledata.Find(aCell, After:=Range("Q1"), LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    
                                        'this gives me a "type mismatch" error that I cannot clear
    
    
                                        '- then wanting the value of the cell offset one column over
                                        'need to take the value of that offset cell and use it
                                        'to replace the value of the original unmerged cell (mCell)
             
        If Not aCell Is Nothing Then
        aCell.Offset(, 1) = bCell.Offset(, 1)
        End If
        Next
        
        'ActiveCell.Offset(1, 0).Select
       ' ActiveCell.Offset(0, 1).Value = ActiveCell.Value
        
      

  Application.DisplayAlerts = True
 
 
  Application.ScreenUpdating = True
 
 End If
 Next mCell
 
  End Sub