[已解决]求复制样表等间距本工作簿内

icenotcool

各位老师，想请老师帮我写一个复制样表的模块，详情在附件内，谢谢老师了！附件 示例.rar (6.16 KB, 下载次数: 7)

2014-2-28 20:32 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-1 10:23

1. Sub Macro1()
   
2. Dim x%, i&, s&
   
3. Sheet2.UsedRange.Clear
   
4. x = Val(InputBox("请输入复制份数"))
   
5. s = 1
   
6. For i = 1 To x
   
7.     Range("a1:d10").Copy Sheet2.Cells(s, 1)
   
8.     s = s + 10
   
9. Next
   
10. With Sheet2.PageSetup
    
11.     .FitToPagesWide = 1
    
12.     .FitToPagesTall = 1
    
13. End With
    
14. Sheet2.Activate
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

既然是模板，大小列宽和行高应该和模板一样，让模板迁就纸张也称不上模板了。

icenotcool

说错了，就是表样结构是一样的

dsmch

1. Sub Macro1()
   
2. Dim x%, i&, s&
   
3. Sheet2.UsedRange.Clear
   
4. x = Val(InputBox("请输入复制份数"))
   
5. s = 1
   
6. For i = 1 To x
   
7.     Range("a1:d10").Copy Sheet2.Cells(s, 1)
   
8.     s = s + 10
   
9. Next
   
10. With Sheet2.PageSetup
    
11.     .FitToPagesWide = 1
    
12.     .FitToPagesTall = 1
    
13. End With
    
14. Sheet2.Activate
    
15. End Sub
    

复制代码

dsmch

………………

icenotcool

你好，我说的不是简单的复制，而是无论分成多少份表格，都自动调整行高，布满整页A4张布局

dsmch

icenotcool 发表于 2014-3-1 10:57
你好，我说的不是简单的复制，而是无论分成多少份表格，都自动调整行高，布满整页A4张布局

代码中有自动调整一页宽、一页高，用打印预览看看。

icenotcool

你留下是空白界面，我要的是表格自动调整为充满整页