新浪博客

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

2017-03-30 14:18阅读：2,711

http://blog.sina.cn/dpool/blog/u/1623808782

Excel VBA用Copy方法进行复制粘贴，往往会导致粘贴的数据没有了行高和列宽。那么，当我们要进行复制粘贴时，如何保证粘贴的数据保留原有的格式(包括行高列宽都不能变)。
笔者以一个模板设计为例进行说明。
模板表如图1 所示。
Excel <wbr>VBA技巧 <wbr>复制粘贴保留行高列宽等所有格式的方法X

图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则只粘贴格式而不粘贴数据。
为了能一次性复制多份，粘贴区域的选择很重要，粘贴区域的行数=样本区域行数×横向份数，粘贴区域的列数=样本区域列数×纵向份数。比如示例中正文区样本为2行3列，现需要横向5份/纵向4份共20份粘贴正文区，则粘贴区域应为2行×5份=10行、3列×4份=12列，即10行12列的区域，所以示例粘贴区域为.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

留言板

下载客户端体验更佳，还能发布图片和表情~

亿万博主正在被热评！
999+

给此博文留言吧！ 有机会上热评榜！ 攒金币兑换礼品！

好的评论会让人崇拜发布评论

关注

我的更多文章

下载客户端阅读体验更佳

APP专享