Paste the selected multiple cells to footer

Hello,


requirement s to selected multiple cells of excel sheet. n paste as it is to footer.. i have searched with goole got a code changed it for my requirement .
But the issue is lik am able to copy selcted cell to some excel sheet other cells.. but not to footer because code contains inputbox.. where we can specify cell .. but not the footer..
so i need d code for (pasterange to footer).

code :
Option Explicit

Sub CopyMultipleSelection()
Dim SelAreas() As Range
Dim PasteRange As Range
Dim UpperLeft As Range
Dim NumAreas As Integer, i As Integer
Dim TopRow As Long, LeftCol As Integer
Dim RowOffset As Long, ColOffset As Integer
Dim NonEmptyCellCount As Integer
Dim ws As Worksheet

Set ws = Worksheets("sheet7")


NumAreas = Selection.Areas.Count
ReDim SelAreas(1 To NumAreas)
For i = 1 To NumAreas
Set SelAreas(i) = Selection.Areas(i)
Next


TopRow = ActiveSheet.Rows.Count
LeftCol = ActiveSheet.Columns.Count
For i = 1 To NumAreas
If SelAreas(i).Row < TopRow Then TopRow = SelAreas(i).Row
If SelAreas(i).Column < LeftCol Then LeftCol = SelAreas(i).Column
Next
Set UpperLeft = Cells(TopRow, LeftCol)


On Error Resume Next

Application.ActiveSheet.PageSetup.CenterFooter = PasteRange
'here am confused it the code

On Error GoTo 0
' Exit if canceled
If TypeName(PasteRange) <> "Range" Then Exit Sub

' Make sure only the upper left cell is used
Set PasteRange = PasteRange.Range("A1")

' Copy and paste each area
For i = 1 To NumAreas
RowOffset = SelAreas(i).Row - TopRow
ColOffset = SelAreas(i).Column - LeftCol

SelAreas(i).Copy PasteRange.Offset(RowOffset, ColOffset)

Next i
End Sub

thank