Office中国论坛/Access中国论坛

标题: 如何将多个表的数据复制到一个表中 [打印本页]

作者: bible_zms 时间: 2008-12-2 16:36
标题: 如何将多个表的数据复制到一个表中
我有N个表，我要将这N个表的内容复制到一个总表中。如何做才快
不要一个一个打开复制粘贴！！！呵呵

作者: pureshadow 时间: 2008-12-2 18:46
多表合一，只能用代码了。。。。。

作者: bible_zms 时间: 2008-12-3 09:02
如何用代码？？请指教

作者: pureshadow 时间: 2008-12-3 14:45
以下是我师傅写，江羽版主注释的，希望对你有帮助：
'==========================================================
Sub test()
Dim i As Long
Dim rngTitle As Range
Dim vData As Variant
Dim lEndRow As Long

'删除"combine"表单元格内容,Delete有几个常量,表示位移方式
Sheets("combine").Cells.Delete

'循环所有表
For i = 1 To Sheets.Count

      '对遍历的所有表进行如下操作
      With Sheets(i)

         '避开"combine"表
         If .Name <> Sheets("combine").Name Then

            '判断是否赋值
            If rngTitle Is Nothing Then

                  '对自定义变量进行赋值,为当前表的A1到L2区域, _
                  这是预留两行标题行,因前题是所有表的表格标题行都是一样的, _
                  所以只复制第一个表的标题行到"combine"表中就可以了
                  Set rngTitle = .Range("A1:L2")

                  '将当前表的A1到L2区域,即标题行复制到"combine"表, _
                  选定"combine"表的A1单元格进行复制
                  rngTitle.Copy Sheets("combine").[a1]
            End If

            '向变量lEndRow进行赋值,该值为当前表的B4单元格所选区域向移动到末端单元格的行
            lEndRow = .[B4].End(xlDown).Row

            '向变量vData赋值,该值为B4到当前表中所有数据最后所在行与12列的交差点的区域
            vData = .Range(.Cells(4, 2), .Cells(lEndRow, 12))

            '重新调整"combine"表区域,将其调整与vData相同,并该区域值复制数据
            With Sheets("combine")
                  .Cells(.[B65536].End(xlUp).Row + 1, 2).Resize(UBound(vData), 11) = vData
            End With
         End If

      End With
Next

'该段代码是向"combine"表的第一列中添加自然编码
With Sheets("combine")
      '从表格最底端向上移动行,并赋值给变量
      lEndRow = .[B65536].End(xlUp).Row
      '表格A3到A4区域输入数组
      .Range("A3:A4") = Application.Transpose(Array(1, 2))
      '选中A3至A4仿拖拉填充,相当于选中A3至A4单元格向下复制,达到自动填充序号的目的
      .Range("A3:A4").AutoFill .Range("A3:A" & lEndRow)
End With
End Sub

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)