Copy header and range from one sheet to another

Question

I am trying to copy a header and a set of data to a new worksheet for printing.

While I can copy the data fine the column widths are lost and running autofit on it again breaks the page. The column widths were set by hand manually when the page was originally designed.

Currently I have:

Dim tmp As Worksheet
Set tmp = Sheets.Add(after:=ActiveSheet)
RD.Copy tmp.Range("A1") ' Range data (set elsewhere)
RH.Copy tmp.Range("A1") ' Range header (set elsewhere)

I've tried using xlPasteSpecial and xlPasteAll but they give no difference while using the clipboard.

What do I need to do to copy the cell widths across sheets?

Answer 1

You could loop through the columns of the source, and set the corresponding ColumnWidths of the target range:

Dim i As Integer
For i = 1 To sourceRange.Columns.Count
    targetRange.Columns(i).ColumnWidth = sourceRange.Columns(i).ColumnWidth
Next

Answer 2

Graham,

After copying the ranges across, just get the column number of the destination range, then iterate through the columns in the source range copying the .ColumnWidth property over...

Dim RD As Range
Dim RH As Range

Set RH = Cells.Range("A1:C1")
Set RD = Cells.Range("A2:C2")

Dim tmp As Worksheet
Set tmp = Sheets.Add(after:=ActiveSheet)
RD.Copy tmp.Range("A1") ' Range data (set elsewhere)'
RH.Copy tmp.Range("A2") ' Range header (set elsewhere)'

' Get the column number of the first cell in the destination range'
' because it looks like we are just setting the first cell of the destination range'
' and letting Excel roll the range over'
Dim tmpCol As Integer
tmpCol = tmp.Range("A1").Cells(1, 1).Column ' make sure you use the same range value'

Now loop through the source columns setting the dest column to the same width.
For Each objCol In RH.Columns

    tmp.Columns(tmpCol).ColumnWidth = objCol.ColumnWidth
    tmpCol = tmpCol + 1

Next