Excel VBA技巧 复制粘贴保留行高列宽等所有格式的方法

时间:2024-02-20 10:08:00

Excel VBACopy方法进行复制粘贴,往往会导致粘贴的数据没有了行高和列宽。那么,当我们要进行复制粘贴时,如何保证粘贴的数据保留原有的格式(包括行高列宽都不能变)

笔者以一个模板设计为例进行说明。

模板表如图1 所示。

Excel <wbr>VBA技巧 <wbr>复制粘贴保留行高列宽等所有格式的方法

1

根据模板表生成表格的效果如图2所示。

Excel <wbr>VBA技巧 <wbr>复制粘贴保留行高列宽等所有格式的方法

2

使用Copy方法复制粘贴,代码如下所示:

Sub Copy复制粘贴困惑()

    Dim x As Integer

   

    With Sheet2

        \'清空数据

        .UsedRange.Clear

        \'恢复标准列宽

        .Columns.ColumnWidth = .StandardWidth

        \'恢复标准行高

        .Rows.RowHeight = .StandardHeight

    End With

   

    For x = 1 To 30 Step 15

        \'复制大标题区

        Sheet1.Rows("3:4").Copy Sheet2.Rows(x)

       

        \'小标题区

        \'横向复制1/纵向复制4---粘贴份数由扩展区域Resize(1, 12)决定

        Sheet1.Range("B5:D5").Copy Sheet2.Cells(x + 2, "B").Resize(1, 12)

       

        \'正文区

        \'横向复制5/纵向复制4---粘贴份数由扩展区域Resize(10, 12)决定

        Sheet1.Range("B6:D7").Copy Sheet2.Cells(x + 3, "B").Resize(10, 12)

    Next x

End Sub

运行代码效果如图3所示。

Excel <wbr>VBA技巧 <wbr>复制粘贴保留行高列宽等所有格式的方法

3

粘贴时为了保证行高和列宽一同被复制,可以先整行使用Copy方法进行复制粘贴,这样就可以保证行高一同被复制;使用PasteSpecial方法选择性粘贴,参数Paste设置为xlPasteColumnWidths即可保证列宽一同被复制,参数Paste设置为xlPasteFormats则只粘贴格式而不粘贴数据。

为了能一次性复制多份,粘贴区域的选择很重要,粘贴区域的行数=样本区域行数×横向份数,粘贴区域的列数=样本区域列数×纵向份数。比如示例中正文区样本为23列,现需要横向5/纵向4份共20份粘贴正文区,则粘贴区域应为2×5=10行、3列×4=12列,即1012列的区域,所以示例粘贴区域为.Cells(x + 3, "B").Resize(10, 12)。如果粘贴区域设置不当将会出现不可意料的效果,请自行测试。

好了,按照上述方法将代码修改成如下所示,运行后即可得到如图2所示效果。

Sub 复制全部格式包括行高列宽()

    Dim x As Integer

   

    With Sheet2

        \'清空数据

        .UsedRange.Clear

        \'恢复标准列宽

        .Columns.ColumnWidth = .StandardWidth

        \'恢复标准行高

        .Rows.RowHeight = .StandardHeight

    End With

   

    For x = 1 To 30 Step 15

        \'复制大标题区

        Sheet1.Rows("3:4").Copy Sheet2.Rows(x)

       

        \'小标题区

        \'复制行高

        Sheet1.Rows(5).Copy Sheet2.Rows(x + 2)

        \'纵向复制4

        Sheet1.Range("B5:D5").Copy Sheet2.Cells(x + 2, "B").Resize(1, 12)

       

        \'正文区

        \'横向复制行高5

        Sheet1.Rows("6:7").Copy

        Sheet2.Rows(x + 3 & ":" & x + 12).PasteSpecial xlPasteFormats   \'选择性粘贴格式

        \'横向复制5/纵向复制4

        Sheet1.Range("B6:D7").Copy

        With Sheet2.Cells(x + 3, "B").Resize(10, 12)

            .PasteSpecial xlPasteFormats  \'选择性粘贴格式

            .PasteSpecial xlPasteColumnWidths \'选择性粘贴列宽

        End With

    Next x

End Sub