将多个数据工作表合并/附加到一个汇总工作表中，然后删除数据工作表答案

【问题标题】：Combine/Append multiple data worksheets into one summary worksheet and then delete data worksheets将多个数据工作表合并/附加到一个汇总工作表中，然后删除数据工作表
【发布时间】：2015-10-29 14:47:54
【问题描述】：

在我的工作簿中，我有一个带有按钮的 FrontPage 工作表。此按钮导入 csv 文件。每个 csv 文件都被导入/复制到自己的工作表中（我们称它们为数据表）。这部分是完整的。在第二部分中，我想将所有这些表合并为一个摘要表，然后删除所有数据表。第二部分几乎完成了。我只需要弄清楚如何将数据表合并到汇总表中后删除它们。

谢谢！

这是目前为止的代码：

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

StartRow = 2

For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> DestSh.Name Then

        Last = LastRow(DestSh)
        shLast = LastRow(sh)

        If shLast > 0 And shLast >= StartRow Then

            Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
               MsgBox "There are not enough rows in the " & _
               "summary worksheet to place the data."
               GoTo ExitTheSub
            End If

            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

        End If

    End If
Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

DestSh.Columns.AutoFit

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

【问题讨论】：

标签： excel csv merge vba

【解决方案1】：

如果您给工作表起方便的名称，您可以简单地遍历所有工作表并删除那些名为 Data[something] 的工作表。

 For i = 1 To ActiveWorkbook.Worksheets.Count
    If Left(Worksheets(i).Name, 4) = "Data" Then
        Application.DisplayAlerts = False
        Worksheets(i).Delete
        Application.DisplayAlerts = True
    End If
 Next

看起来您已经完成了 3/4 的代码（循环和名称检查）。

【讨论】：

【解决方案2】：

复制完需要复制的内容，添加：

Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True

这将删除工作表并取消用户接受/拒绝删除的要求。

看起来这会在这个块之后立即进行：

        CopyRng.Copy
        With DestSh.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With

【讨论】：