Copy and Paste Number Formatting Only

Maybe :

Public arrNumberFormat() As String
Public Sub CopyNumberFormat()
  Dim i As Long, j As Long
  If TypeName(selection) <> "Range" Then Exit Sub
  ReDim arrNumberFormat(1 To selection.Rows.Count, 1 To selection.Columns.Count)
  Application.ScreenUpdating = False
  For i = 1 To selection.Rows.Count
      For j = 1 To selection.Columns.Count
          arrNumberFormat(i, j) = selection.Cells(i, j).NumberFormat
      Next j
  Next i
  Application.ScreenUpdating = True
End Sub
Public Sub PasteNumberFormat()
  Dim i As Long, j As Long
  If TypeName(selection) <> "Range" Then Exit Sub
  Application.ScreenUpdating = False
  If UBound(arrNumberFormat, 1) = 1 Then
     For j = 1 To Application.Min(selection.Columns.Count, UBound(arrNumberFormat, 2))
         If Len(arrNumberFormat(1, j)) Then selection.Columns(j).Cells.NumberFormat = arrNumberFormat(1, j)
     Next j
  ElseIf UBound(arrNumberFormat, 2) = 1 Then
     For i = 1 To Application.Min(selection.Rows.Count, UBound(arrNumberFormat, 1))
         If Len(arrNumberFormat(i, 1)) Then selection.Rows(i).Cells.NumberFormat = arrNumberFormat(i, 1)
     Next i
  Else
     For i = 1 To Application.Min(selection.Rows.Count, UBound(arrNumberFormat, 1))
         For j = 1 To Application.Min(selection.Columns.Count, UBound(arrNumberFormat, 2))
             If Len(arrNumberFormat(i, j)) Then selection.Cells(i, j).NumberFormat = arrNumberFormat(i, j)
         Next j
     Next i
  End If
  Application.ScreenUpdating = True
End Sub