Копирование заголовка и диапазона с одного листа на другой

Question

Я пытаюсь скопировать заголовок и набор данных на новый лист для печати.

Хотя я могу нормально копировать данные, ширина столбцов теряется, и запуск автоподбора снова приводит к поломке страницы.Ширина столбцов была установлена ​​вручную при первоначальном дизайне страницы.

На данный момент у меня есть:

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)

Я пробовал использовать xlPasteSpecial и xlPasteAll, но они не дают никакой разницы при использовании буфера обмена.

Что мне нужно сделать, чтобы скопировать ширину ячеек на листах?

Answer 1

Грэм,

После копирования диапазонов просто получите номер столбца целевого диапазона, затем пройдитесь по столбцам в исходном диапазоне, копируя свойство .ColumnWidth поверх...

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

Answer 2

Вы можете просмотреть столбцы источника и установить соответствующие ColumnWidths целевого диапазона:

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