Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 7770|回复: 9

[已解决]我想把前边三个表格中的数据按顺序复制到第四个表格中,使用以下代码提示错误,怎...

[复制链接]
发表于 2012-10-30 15:06 | 显示全部楼层 |阅读模式
本帖最后由 qjsu 于 2012-10-30 15:10 编辑

我想把前边三个表格中的数据按顺序复制到第四个表格中,使用以下代码提示错误,应该怎么修改啊?附件是生成之后的例子,请参考

ps:最好不要重新编一个,我就是想知道我这个代码哪里错了!!按照我的思路修改是最好了

Public Sub 复制配置清单()
Dim s As Integer
Dim x As Integer
Dim row As Integer
For s = 1 To Sheets.Count - 1
Worksheets("Sheet" & s).Activate
ReDim Preserve row(s) As Integer
row(s) = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).row
ReDim Preserve x(s) As Integer
x(0) = 1
x(s) = x(s) + row(s)
Range("A2").Select
ActiveCell.CurrentRegion.Select
Selection.Copy
   
Sheets("Sheet" & Sheets.Count).Select
Range("A" & x(s)).Select
   
ActiveSheet.Paste
Next
   
End Sub
最佳答案
2012-10-30 16:35
  1. Public Sub 复制配置清单()

  2.     Dim s As Integer
  3.    
  4.     Dim x
  5.    
  6.     Dim row
  7.    
  8.     Worksheets("sheet4").Cells.Clear

  9.     For s = 1 To Sheets.Count - 1

  10.         With Worksheets("Sheet" & s)
  11.             i = Worksheets("sheet4").Range("a65536").End(xlUp).row
  12.             If i <> 1 Then i = i + 2
  13.             .Range("a1").CurrentRegion.Copy Worksheets("sheet4").Cells(i, 1)
  14.         End With

  15.     Next
  16.    
  17. End Sub
复制代码

新建 Microsoft Office Excel 工作表.zip

20.03 KB, 下载次数: 146

发表于 2012-10-30 16:35 | 显示全部楼层    本楼为最佳答案   
  1. Public Sub 复制配置清单()

  2.     Dim s As Integer
  3.    
  4.     Dim x
  5.    
  6.     Dim row
  7.    
  8.     Worksheets("sheet4").Cells.Clear

  9.     For s = 1 To Sheets.Count - 1

  10.         With Worksheets("Sheet" & s)
  11.             i = Worksheets("sheet4").Range("a65536").End(xlUp).row
  12.             If i <> 1 Then i = i + 2
  13.             .Range("a1").CurrentRegion.Copy Worksheets("sheet4").Cells(i, 1)
  14.         End With

  15.     Next
  16.    
  17. End Sub
复制代码
回复

使用道具 举报

发表于 2012-10-30 16:37 | 显示全部楼层
你的思路我没看明白。
直接复制就很快了。
回复

使用道具 举报

发表于 2012-10-30 16:39 | 显示全部楼层
动态数组建议多看下帮助
回复

使用道具 举报

发表于 2012-10-30 16:49 | 显示全部楼层
二楼的这二个变量没有作用:
Dim x
   
Dim row
回复

使用道具 举报

 楼主| 发表于 2012-10-30 16:57 | 显示全部楼层
hwc2ycy 发表于 2012-10-30 16:39
动态数组建议多看下帮助

ReDim Preserve row(s) As Integer运行到这一句的时候提示缺少数组
回复

使用道具 举报

 楼主| 发表于 2012-10-30 16:58 | 显示全部楼层
wp8680 发表于 2012-10-30 16:49
二楼的这二个变量没有作用:
Dim x
   

我也知道,呵呵~~帮忙解答一下楼上的问题私密噶~~
回复

使用道具 举报

 楼主| 发表于 2012-10-30 17:11 | 显示全部楼层
我自己研究了另外一个方法,思路是把所有工作表反着排列即sheet3、sheet2、sheet1,然后复制sheet3,再插入一行之后再复制sheet2,同理复制sheet1,这样好像就简单多了
回复

使用道具 举报

发表于 2012-10-30 17:32 | 显示全部楼层
wp8680 发表于 2012-10-30 16:49
二楼的这二个变量没有作用:
Dim x
   

只改了中间,测试了下,前面的没注意了。

刚在路上在想了下,得考虑下是否空表的情况。
回复

使用道具 举报

发表于 2012-10-30 17:42 | 显示全部楼层
  1. Public Sub 复制配置清单()

  2.     Dim i As Long
  3.     Dim shtDest
  4.     Dim s As Long
  5.     Set shtDest = Worksheets(Worksheets.Count)
  6.    
  7.     shtDest.Cells.Clear
  8.    
  9.     For s = 1 To Sheets.Count - 1

  10.         With Worksheets(s)
  11.         
  12.             i = shtDest.Range("a65536").End(xlUp).row
  13.             
  14.             If i <> 1 Then i = i + 2
  15.               
  16.             If Len(.Range("A1").Value) > 0 Then .Range("a1").CurrentRegion.Copy shtDest.Cells(i, 1)
  17.             
  18.         End With
  19.    
  20.     Next

  21. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
qjsu + 3 很给力!

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 18:12 , Processed in 1.234259 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表