Vba 清除工作表的内容

Vba 清除工作表的内容,vba,excel,Vba,Excel,我有一个组合图纸的宏。当条目添加到各个工作表时,我希望合并的工作表刷新 我在其他表格上有引用合并表格的公式 在合并代码中,合并的图纸(如果存在)将被删除,然后再次添加。这把所有的公式参考都搞乱了。我想删除删除并重新添加合并工作表的部分,而是清除工作表的内容,然后合并数据 这是我到目前为止的代码 Sub CopyRangeFromMultiWorksheets() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As

我有一个组合图纸的宏。当条目添加到各个工作表时,我希望合并的工作表刷新

我在其他表格上有引用合并表格的公式

在合并代码中,合并的图纸(如果存在)将被删除,然后再次添加。这把所有的公式参考都搞乱了。我想删除删除并重新添加合并工作表的部分,而是清除工作表的内容,然后合并数据

这是我到目前为止的代码

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

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

    'Delete the sheet "CombinedReport" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("CombinedReport").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "CombinedReport"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.name = "CombinedReport"

    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Sheets(Array("UCDP", "UCD", "ULDD", "PE-WL", "eMortTri", "eMort", "EarlyCheck", "DU", "DO", "CDDS", "CFDS"))        
        Last = DestSh.Cells.SpecialCells(xlCellTypeLastCell).Row    

        'Fill in the range that you want to copy
        Set CopyRng = sh.UsedRange
        Set CopyRng = CopyRng.Offset(1, 0).Resize(CopyRng.Rows.Count - 1, CopyRng.Columns.Count)


        'Test if there enough rows in the DestSh to copy all the data
        If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
            MsgBox "There are not enough rows in the Destsh"
            GoTo ExitTheSub
        End If

        'This example copies values/formats, if you only want to copy the
        'values or want to copy everything look at the example below this macro
        CopyRng.Copy
        With DestSh.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With

    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

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

我想这应该可以。我假设公式在其他表单上,并参考目标表单?这段代码假设您有一个“combinedreport”表作为开始

Sub x()

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

Set destsh = ActiveWorkbook.Sheets("CombinedReport")
destsh.UsedRange.ClearContents

'loop through all worksheets and copy the data to the DestSh
For Each sh In ActiveWorkbook.Sheets(Array("UCDP", "UCD", "ULDD", "PE-WL", "eMortTri", "eMort", "EarlyCheck", "DU", "DO", "CDDS", "CFDS"))
    Last = destsh.Range("A" & Rows.Count).End(xlUp).Row
    'Fill in the range that you want to copy
    Set CopyRng = sh.UsedRange
    Set CopyRng = CopyRng.Offset(1, 0).Resize(CopyRng.Rows.Count - 1, CopyRng.Columns.Count)

    'Test if there enough rows in the DestSh to copy all the data
    If Last + CopyRng.Rows.Count > destsh.Rows.Count Then
        MsgBox "There are not enough rows in the Destsh"
        GoTo ExitTheSub
    End If

    'This example copies values/formats, if you only want to copy the
    'values or want to copy everything look at the example below this macro
    CopyRng.Copy
    With destsh.Cells(Last + 1, "A")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
    End With
Next

ExitTheSub:

Application.Goto destsh.Cells(1)

'AutoFit the column width in the DestSh sheet
destsh.Columns.AutoFit

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

End Sub

如果你已经有一个问题有待解决,那么在没有提及现有帖子的情况下发布一个副本是有点不体贴的。。。