Copying Data From One Range to Another By Averaging the Intersection

[Admin]

Hi,

Select the two ranges and run the code.

Sub Average2Range()
    
    Dim r   As Range
    Dim a   As String
    Dim i   As Long
    Dim c   As Long
    Dim v
    
    Set r = Selection
    
    a = r.Address(0, 0)
    
    v = Split(a, ",")
    
    If Range(v(0)).Rows.Count <> Range(v(1)).Rows.Count Then
        MsgBox "Row count must be same"
        Exit Sub
    ElseIf Range(v(0)).Columns.Count <> Range(v(1)).Columns.Count Then
        MsgBox "Column count must be same"
        Exit Sub
    End If
    
    With r.Parent
        For i = 1 To .Range(v(0)).Rows.Count
            For c = 1 To .Range(v(0)).Columns.Count
                .Range(v(0)).Cells(i, c) = Evaluate("iferror(average(" & .Range(v(0)).Cells(i, c).Address(0, 0) & "," & .Range(v(1)).Cells(i, c).Address(0, 0) & "),"""")")
            Next
        Next
    End With
    
End Sub