如何批量提取多个工作表的固定列里的数据，复制到一个工作表中！

gongwei01 · 发表于 2010-9-25 16:39

color=Magenta]如何把所有工作表中（工作表共有200多个，格式都一样，数据开始行都是第6行，结束行不一样）的C、D、E 三列内容，全部复制到合计表中

统计.rar (6.98 KB, 下载次数: 763)
纯一条条复制就行，不用汇总！！！！！
手工一个个复制太麻烦，想自动化批量完成

[ 本帖最后由 YZLSZAJ 于 2010-12-30 20:17 编辑 ]

XZ19860527 · 发表于 2010-9-25 16:53

Sub TEXT()
Dim SH As Worksheet
Dim i%, j%
For Each SH In Worksheets
If SH.Name <> "合计" Then
   j = Sheets("合计").Range("a1").End(xlDown).Row
   i = SH.Range("c6").End(xlDown).Row
   SH.Range("c6:e" & i).Copy Sheets("合计").Range("a1").Offset(j, 0)
End If
Next
End Sub
运行了下格式一样是可以的

[ 本帖最后由 XZ19860527 于 2010-9-25 16:57 编辑 ]

拼音佳佳 · 发表于 2010-9-25 16:54

这个非vba不可了.我只有土方子,等高人先做...

shell "cmd /c dir 路径 /b"
这个可以获得文件名的列表,再用"导入外部数据"的功能列出文件名
之后用循环就可以把数据集中起来了...

问题在于,这个,shell命令,这个是土方子,拿不出手,呵呵...

zhz3230 · 发表于 2010-9-25 17:08

Sub zhz3230()
For k = 1 To Sheets.Count
If Sheets(k).Name <> "合计" Then
Sheets(k).Range("c6:e" & Sheets(k).Range("e65536").End(xlUp).Row).Copy Sheets("合计").Range("a" & Sheets("合计").Range("a65536").End(xlUp).Row)
End If
Next
End Sub

gongwei01 · 发表于 2010-9-25 17:18

原帖由 XZ19860527 于 2010-9-25 16:53 发表
Sub TEXT()
Dim SH As Worksheet
Dim i%, j%
For Each SH In Worksheets
If SH.Name  "合计" Then
   j = Sheets("合计").Range("a1").End(xlDown).Row
   i = SH.Range("c6").End(xlDown).Row
  ...

运行提示“溢出”？？？？？什么意思？

gongwei01 · 发表于 2010-9-25 17:22

原帖由 zhz3230 于 2010-9-25 17:08 发表
Sub zhz3230()
For k = 1 To Sheets.Count
If Sheets(k).Name "合计" Then
Sheets(k).Range("c6:e" & Sheets(k).Range("e65536").End(xlUp).Row).Copy Sheets("合计").Range("a" & Sheets("合计").Range("a65536 ...

这个好像可以，OK，谢谢，太感谢了！！！！！！

XZ19860527 · 发表于 2010-9-25 17:23

需要在合计表A2有列标题否则会溢出

qdchyq · 发表于 2010-9-25 17:31

Sub TEXT()
Dim SH As Worksheet
Dim i%, j%
For Each SH In Worksheets
If SH.Name <> "合计" Then
   j = Sheets("合计").Range("a65536").End(xlUp).Row
   i = SH.Range("c6").End(xlDown).Row
   SH.Range("c6:e" & i).Copy Sheets("合计").Range("a1").Offset(j, 0)
End If
Next
End Sub

cafkyy · 发表于 2010-9-25 19:51

Sub TEXT()
Dim SH As Worksheet
Dim i%, j%, d
Set d = CreateObject("Scripting.Dictionary")
For Each SH In Worksheets
      If SH.Name <> "合计" Then
         For j = 6 To SH.[c6].End(4).Row
            i = i + 1
            d(i) = SH.Rows(j)
         Next
      End If
Next
For Each cl In d.keys
      Sheets("合计").Rows(cl + 1) = d(cl) '这个1，根据实际情况更改
Next
Columns("A:B").Delete '这一句是删除前面的两列空格
End Sub
楼主比较一下，这个代码是不是更快

gongwei01 · 发表于 2010-9-25 20:48

原帖由 gongwei01 于 2010-9-25 17:22 发表

这个好像可以，OK，谢谢，太感谢了！！！！！！

不行，成功，但好像少了一些行！！！！

		自动登录	找回密码
密码			免费注册

[求助] 如何批量提取多个工作表的固定列里的数据，复制到一个工作表中！

回复 5楼 gongwei01 的帖子

回复 1楼 gongwei01 的帖子