用VBA编写合并多个工作表的数据到一张表中

Public Sub AutoCopy()

Dim MyPath As String

Dim MyName As String

Dim AllName() As String

Dim MyWB As Workbook

i = 0

ApplicationScreenUpdating = False

MyPath = "C:\Users\Public\Documents\microsoft\test"

ActiveSheetRange("A1") = "工号"

ActiveSheetRange("B1") = "姓名"

ActiveSheetRange("C1") = "工序"

If Right(MyPath, 1) <> "\" Then

MyPath = MyPath & "\"

End If

MyName = Dir(MyPath & "xlsx", 0)

Do While MyName <> ""

ReDim Preserve AllName(i)

AllName(i) = MyName

i = i + 1

MyName = Dir

Loop

For j = 0 To i - 1

If AllName(j) <> "" Then

'ActiveSheetCells(j + 1, 6) = AllName(j) & " " & j

Set MyWB = GetObject(MyPath & AllName(j))

ThisWorkbookSheets(1)Range("A" & ActiveSheetRange("A65535")End(xlUp)Row + 1 & ":C" & _

ActiveSheetRange("A65535")End(xlUp)Row + MyWBSheets(1)Range("D65535")End(xlUp)Row - 1)Value _

= MyWBSheets(1)Range("B2:D" & MyWBSheets(1)Range("D65535")End(xlUp)Row)Value

Workbooks(AllName(j))Close

End If

Next j

ApplicationScreenUpdating = True

End Sub

试试这个看 要把MyPath = "C:\Users\Public\Documents\microsoft\test"改成你自己的文件夹路径

10比如工作表1数据一万行,工作表2数据1万行,汇总成20000行的工作表!要是能用宏解决的话,请帮忙写一个!跪谢了!补充：不是非要用宏啦,我只想找个快速简单的方法汇总,应该你们懂的,一万行的数据,我点一下复制,要等好半天才能反应过来!所以不管是什么方法,能办到就可以了!

HE回答的,我马上去试试,先谢一下!满意答案:)HE17级2011-08-18

不需要宏吧，很简单的：

点工作表2，在名称栏（在公示栏左边的那个白色框框）输入

2:10001，回车（注意英文字符），就选中了所有的数据，右键，复制；

到工作表1，选中单元格A2，鼠标双击其下边框，就到了数据的最底部，再按个下方向键，就选中了单元格A10002，回车粘贴，完成。

补充：

非要用宏的话，也很简单：Sub

test()Sheets("Sheet2")Range("1:20000")Copy

Sheets("Sheet1")Range("A65535")End(xlUp)Offset(1,

0)End

SubTIDE潮流店--

的感言：

哎,还是有点麻烦,不过谢谢你了!

2011-08-20其他回答(1)

热心问友

2011-08-18不用宏可以吗？用=某某工作表！某某列然后拖动

希望对你能有所帮助。

如果是复制到多个工作表中相同的位置，那很好办，不用vba也可以，但是如果是复制到多个工作表中不同的位置上，那就只有VBA了，并且这些位置还得有规律，对于没有规律的复制来讲，写VBA的时候，还不如自己手动复制了呢。

按Alt+F11进入VBA界面，Alt+i+m进入模块，复制一下代码，按F5即可

For j = 2 To 5 '如果更多表则更改这个数字

'假设目前只有表一，所以剩下的表都是添加的如果不是，请将这三行代码删除

SheetsAdd

ApplicationCutCopyMode = False

ActiveSheetMove After:=ActiveWorkbookSheets(ActiveWorkbookSheetsCount)

Sheets(1)Range("A4:R" & [a65535]End(xlUp)Row)copySheets(i)Range ("A4")

Next

End Sub

Sub 多工作簿工作表汇总()

    Dim Cnn As Object, Rst As Object, Rs As Object, FilePath$, FullName$, FullPath$, Sql$, Sht_Name$, i&

    Set Cnn = CreateObject("ADODBConnection")

    Set Rst = CreateObject("ADODBRecordset")

    FilePath = ThisWorkbookPath

    FullName = Dir(FilePath & "\xls")

    Do While FullName <> ""

        If FullName <> ThisWorkbookName Then

            FullPath = FilePath & "\" & FullName

            CnnOpen "Provider=MicrosoftAceOledb120;Extended Properties=Excel 120;Data Source=" & FullPath

            Set Rst = CnnOpenSchema(20)

            Do Until RstEOF

                Sht_Name = Rst("TABLE_NAME")Value

                If Sql = "" Then

                    Sql = "select from [" & FullPath & "][" & Sht_Name & "]"

                Else

                    Sql = Sql & " Union all select from [" & FullPath & "][" & Sht_Name & "]"

                End If

                RstMoveNext

            Loop

            RstClose

            CnnClose

        End If

        FullName = Dir

    Loop

    CnnOpen "Provider=MicrosoftAceOledb120;Extended Properties=Excel 120;Data Source=" & ThisWorkbookFullName

    Set Rs = CnnExecute(Sql)

    For i = 0 To RsFieldsCount - 1

        Cells(1, i + 1)Value = RsFields(i)Name

    Next i

    [a2]CopyFromRecordset Rs

    CnnClose

    Set Rs = Nothing

    Set Rst = Nothing

    Set Cnn = Nothing

End Sub

以上就是关于用VBA编写合并多个工作表的数据到一张表中全部的内容，包括:用VBA编写合并多个工作表的数据到一张表中、EXCEL、vba如何把多个工作表里的数据汇总、excel vba怎么把一个工作表里的数据复制到多个工作表里等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！