将页眉和范围从一张纸复制到另一张纸

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

您可以遍历源代码的列，并设置目标范围的相应ColumnWidths：

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

Answer 2

格雷厄姆

复制范围后，只需获取目标范围的列号，然后遍历源范围中的列，将.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