VBA汇总一个文件多工作表到一个表

哆哆Excel

发布于 2022-10-31 15:09:04

79600

代码可运行

文章被收录于专栏：哆哆Excel哆哆Excel

运行总次数：0

代码可运行

VBA汇总一个文件多工作表到一个表

今天在工作中，同事传来一个excel文件中有很多个工作表，要我汇总，每个表的标题是一样的，虽然一个一个复制、粘贴是可以做到的，但时间很长，所以把以前学习一个代码，拿来用一下，代码找了很久才找到，想想还是把他放在这里好一点，以后查找方便

把多个工作表的内容汇总到一个“汇总”表中

Sub sheets_to_one()

    Dim mysht As Worksheet, rng As Range, sht As Worksheet

    Dim k

    ti = Timer()

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    

    Set mysht = ActiveSheet

    title_row = Val(Input("请输入标题行数", "提示"))

    If title_row < 0 Then

        MsgBox "标题行数不能为负数"

        Exit Sub

    End If

    mysht.Cells.ClearComments

    mysht.Cells.NumberFormatLocal = "@"

    k = 0

    For Each sht In Worksheets

        If sht.Name <> mysht.Name Then

            LastRow = mysht.Cells(Rows.Count, 1).End(xlUp).Row + 1

            Set rng = sht.UsedRange

            If k = 0 Then

                rng.Copy

                mysht.Cells(1, 1).PasteSpecial Paste:=xlPasteValues

            Else

                rng.Offset(title_row).Copy

                mysht.Cells(LastRow, 1).PasteSpecial Paste:=xlPasteValues

            End If

            k = k + 1

        End If

    Next

    mysht.UsedRange.Borders.LineStyle = xlContinuous

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

    MsgBox "汇总了" & k & "个工作表" & Chr(13) & "用时：" & VBA.Round(Timer() - ti, 2) & "秒"

End Sub

效果：.