将多个数据工作表合并/附加到一个摘要工作表中,然后删除数据工作表

时间:2015-08-06 12:37:45

标签: excel-vba csv merge vba excel

在我的工作簿中,我有一个带按钮的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

2 个答案:

答案 0 :(得分:0)

如果您给工作表提供方便的名称,您可以简单地遍历所有工作表并删除那些名为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的代码(循环和名称检查)继续。

答案 1 :(得分:0)

复制需要复制的内容后,只需添加:

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
相关问题