{"id":548,"date":"2011-12-23T16:28:58","date_gmt":"2011-12-23T14:28:58","guid":{"rendered":"http:\/\/www.calvert.ch\/maurice\/?p=548"},"modified":"2017-04-28T10:46:03","modified_gmt":"2017-04-28T08:46:03","slug":"excel-copying-cell-valuesformulas-without-using-the-clipboard","status":"publish","type":"post","link":"https:\/\/www.calvert.ch\/maurice\/2011\/12\/23\/excel-copying-cell-valuesformulas-without-using-the-clipboard\/","title":{"rendered":"Excel: Copying cell values\/formulas\/formats without using the clipboard"},"content":{"rendered":"<p>I though this would be trivial; turns out it&#8217;s not.<\/p>\n<ul>\n<li>When you copy a formula from the clipboard, relative references are adjusted, so <code>Range(x).Formula=Range(y).Formula<\/code> doesn&#8217;t produce the expected results.<br \/>\nThe correct way is <code>Range(x).Formula=Range(y).FormulaR1C1<\/code>. Easy once you&#8217;ve been there.<\/li>\n<li>Copying border formats with <code>Range(x).Borders=Range(y).Borders<\/code> crashes Excel. You have to copy each individual border, left, right, top, etc.<\/li>\n<li>Similarly for fonts, you have to copy the font attributes one by one.<\/li>\n<li>Good practice: check that the areas have compatible sizes and don&#8217;t overlap.<\/li>\n<\/ul>\n<p>Nothing inordinately difficult, but time-consuming to get right. Here&#8217;s the code:<\/p>\n<div><span style=\"font-size: 11px;\"><\/span><\/div>\n<p><span style=\"font-size: 11px;\"><\/p>\n<pre>Option Explicit\r\n\r\n' Copy cells without using the clipboard.\r\n'\r\n' Source is a range from which to copy values\/formulas\/formats.\r\n' Dest is the destination range. Must be either\r\n'     a single cell, the top-left of the target range. The source size (rows x columns) is copied.\r\n'   or\r\n'     a range exactly the same size as source. We throw an error if the shapes don't match.\r\n'\r\n' If 'what' is omitted, copies the values.\r\n' what=CopyFormulas copies the formulas instead of the values.\r\n' what=CopyFormats copies the formats.\r\n' what=CopyFormulas+CopyFormats copies both.\r\n'\r\n' Examples:\r\n'   CopyCells Range(\"b2:c6\"), Range(\"h10\")                                   ' Copies 8 cells (6x2) from B2 to H10\r\n'   CopyCells Range(cells(2,2),cells(6,3)), Range(\"h10\")                     ' Idem\r\n'   CopyCells Range(cells(2,2),cells(6,3)), Range(cells(10,10),cells(14,12)) ' Fails, source is 6x2, dest is 6x3\r\n'   CopyCells Range(\"b2:c6\"), Range(\"b3\")                                    ' Fails, source and dest intersect\r\n\r\nPublic Const CopyFormulas = 1\r\nPublic Const CopyFormats = 2\r\nPublic Sub CopyCells(source As Range, dest As Range, Optional what As Long)\r\n\r\n    ' Turn off screen updating, wastes (a lot of) time\r\n    Dim updating As Boolean\r\n    updating = Application.ScreenUpdating\r\n    Application.ScreenUpdating = False\r\n\r\n    If IsMissing(what) Then\r\n        what = 0\r\n    End If\r\n\r\n    Dim r As Long\r\n    Dim c As Long\r\n\r\n    ' If destination is not a singe (r,c) top-left cell, ensure that the ranges are the same shape and size\r\n    If dest.Rows.Count &gt; 1 Or dest.Columns.Count &gt; 1 Then\r\n\r\n        If dest.Rows.Count &lt;&gt; source.Rows.Count Or _\r\n           dest.Columns.Count &lt;&gt; source.Columns.Count Then\r\n\r\n            Err.Raise 1000, \"CopyCells\", \"Destination area \" &amp; dest.Rows.Count &amp; \"x\" &amp; dest.Columns.Count &amp; _\r\n                \" is not the same shape as the source area \" &amp; source.Rows.Count &amp; \"x\" &amp; source.Columns.Count\r\n\r\n        End If\r\n    End If\r\n\r\n    If Not (Intersect(source, dest) Is Nothing) Then\r\n            Err.Raise 1000, \"CopyCells\", \"Source area \" &amp; Replace(source.Address, \"$\", \"\") &amp; \" \" &amp; source.Rows.Count &amp; \"x\" &amp; source.Columns.Count &amp; _\r\n                \" intersects destination area \" &amp; Replace(dest.Address, \"$\", \"\") &amp; \" \" &amp; dest.Rows.Count &amp; \"x\" &amp; dest.Columns.Count\r\n    End If\r\n\r\n    For r = 1 To source.Rows.Count\r\n\r\n        For c = 1 To source.Columns.Count\r\n\r\n            If what And CopyFormulas Then\r\n                dest.Cells(r, c).Formula = source.Cells(r, c).FormulaR1C1\r\n            Else\r\n                dest.Cells(r, c).Value = source.Cells(r, c).Value\r\n            End If\r\n\r\n            If what And CopyFormats Then\r\n\r\n                Dim b As Long\r\n                For b = xlEdgeLeft To xlInsideHorizontal\r\n                    With source.Cells(r, c).Borders(b)\r\n                        dest.Cells(r, c).Borders(b).Weight = .Weight ' You must do this *before* linestyle\r\n                        dest.Cells(r, c).Borders(b).LineStyle = .LineStyle\r\n                        dest.Cells(r, c).Borders(b).ColorIndex = .ColorIndex\r\n                        dest.Cells(r, c).Borders(b).TintAndShade = .TintAndShade\r\n                    End With\r\n                Next\r\n                dest.Cells(r, c).ColumnWidth = source.Cells(r, c).ColumnWidth\r\n                dest.Cells(r, c).Interior.Color = source.Cells(r, c).Interior.Color\r\n                dest.Cells(r, c).Interior.Pattern = source.Cells(r, c).Interior.Pattern\r\n                dest.Cells(r, c).HorizontalAlignment = source.Cells(r, c).HorizontalAlignment\r\n                dest.Cells(r, c).IndentLevel = source.Cells(r, c).IndentLevel\r\n                dest.Cells(r, c).NumberFormat = source.Cells(r, c).NumberFormat\r\n                dest.Cells(r, c).Orientation = source.Cells(r, c).Orientation\r\n                dest.Cells(r, c).RowHeight = source.Cells(r, c).RowHeight\r\n                dest.Cells(r, c).UseStandardHeight = source.Cells(r, c).UseStandardHeight\r\n                dest.Cells(r, c).UseStandardWidth = source.Cells(r, c).UseStandardWidth\r\n                dest.Cells(r, c).VerticalAlignment = source.Cells(r, c).VerticalAlignment\r\n                dest.Cells(r, c).WrapText = source.Cells(r, c).WrapText\r\n\r\n                With source.Cells(r, c).Font\r\n                    dest.Cells(r, c).Font.Background = .Background\r\n                    dest.Cells(r, c).Font.Bold = .Bold\r\n                    dest.Cells(r, c).Font.Color = .Color\r\n                    dest.Cells(r, c).Font.ColorIndex = .ColorIndex\r\n                    dest.Cells(r, c).Font.FontStyle = .FontStyle\r\n                    dest.Cells(r, c).Font.Italic = .Italic\r\n                    dest.Cells(r, c).Font.Shadow = .Shadow\r\n                    dest.Cells(r, c).Font.Size = .Size\r\n                    dest.Cells(r, c).Font.Strikethrough = .Strikethrough\r\n                    dest.Cells(r, c).Font.Subscript = .Subscript\r\n                    dest.Cells(r, c).Font.Superscript = .Superscript\r\n                    dest.Cells(r, c).Font.Underline = .Underline\r\n                End With\r\n                On Error GoTo 0\r\n            End If\r\n\r\n        Next\r\n    Next\r\n\r\n    Application.ScreenUpdating = updating\r\n\r\nEnd Sub\r\n\r\nSub test()\r\n    CopyCells Range(\"b2:c6\"), Range(\"h10\"), CopyFormulas + CopyFormats\r\nEnd Sub<\/pre>\n<p>\u00a0<\/p>\n<p><\/span><\/p>\n","protected":false},"excerpt":{"rendered":"<p>I though this would be trivial; turns out it&#8217;s not. When you copy a formula from the clipboard, relative references are adjusted, so Range(x).Formula=Range(y).Formula doesn&#8217;t produce the expected results. The correct way is Range(x).Formula=Range(y).FormulaR1C1. Easy once you&#8217;ve been there. Copying <a href='https:\/\/www.calvert.ch\/maurice\/2011\/12\/23\/excel-copying-cell-valuesformulas-without-using-the-clipboard\/' class='excerpt-more'>[&#8230;]<\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[47,11],"tags":[19],"class_list":["post-548","post","type-post","status-publish","format-standard","hentry","category-programming","category-technology","tag-excel","category-47-id","category-11-id","post-seq-1","post-parity-odd","meta-position-corners","fix"],"_links":{"self":[{"href":"https:\/\/www.calvert.ch\/maurice\/wp-json\/wp\/v2\/posts\/548","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.calvert.ch\/maurice\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.calvert.ch\/maurice\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.calvert.ch\/maurice\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.calvert.ch\/maurice\/wp-json\/wp\/v2\/comments?post=548"}],"version-history":[{"count":6,"href":"https:\/\/www.calvert.ch\/maurice\/wp-json\/wp\/v2\/posts\/548\/revisions"}],"predecessor-version":[{"id":908,"href":"https:\/\/www.calvert.ch\/maurice\/wp-json\/wp\/v2\/posts\/548\/revisions\/908"}],"wp:attachment":[{"href":"https:\/\/www.calvert.ch\/maurice\/wp-json\/wp\/v2\/media?parent=548"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.calvert.ch\/maurice\/wp-json\/wp\/v2\/categories?post=548"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.calvert.ch\/maurice\/wp-json\/wp\/v2\/tags?post=548"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}