vba复制excel工作簿中所有表的某一列到另一个工作簿中

工作簿“原始数据”中有数量未知,工作表名为1到N的sheet
要将每个sheet的C列依次全部复制到工作簿“整理汇总”sheet1的A列中
自己胡乱编的,每次都只能复制“原始数据”的第一个工作表的C列N遍
Sub xxxx()
Dim c As Worksheet
For Each c In Worksheets
ls = c.Range("c65535").End(3).Row
Range("c1:c" & ls).Select
Selection.Copy
Windows("整理汇总").Activate
ls2 = Range("a65535").End(3).Row
Range("a" & ls2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("原始数据").Activate
Next
End Sub
求指导

Range("c1:c" & ls).Select 这一句,应改为c.Range("c1:c" & ls).Select,前面再加一句,c.select

你循环了 原始数据 的每一个工作表,但是没有改变被选择的工作表,所以每次复制的都是被选择的那个工作表,就会被复制N遍了。

顺便说一下,你这样复制效率很低,因为要不断的切换激活的窗口,改变被选择的工作表,阳光上的桥的答案是效率很高的,不用切换激活的窗口,改变被选择的工作表,但是他的答案不符合你的要求,不是全部复制到A列,是复制到很多列了。给你改进了一下,如下:

Sub xxxx()
    Dim c As Worksheet
    Windows("整理汇总").Activate
    For Each c In  Workbooks("原始数据").Worksheets
        ls2 = Workbooks("整理汇总").ActiveSheet.Range("a65535").End(3).Row
        ls = c.Range("c65535").End(3).Row
        c.Range("c1:c" & ls).Copy Workbooks("整理汇总").ActiveSheet.Range("a" & ls2)
    Next
End Sub

温馨提示:内容为网友见解,仅供参考
第1个回答  2015-01-21
Option Explicit

Sub xxxx()
    Dim c As Worksheet, j As Long
    j = 1
    For Each c In Workbooks("原始数据").Sheets
        c.Rows("C").Copy        Workbooks("整理汇总").Sheets(1).Rows (j)
        j = j + 1
    Next
End Sub

这个代码是不是很简单,能看懂吧,把 原始数据 每个表的C列复制到 整理汇总 第一个表的1、2、3……列

本回答被网友采纳
相似回答