Question

我有一个结合了纸张的宏。我希望在将条目添加到各个工作表时刷新组合工作表。

我在其他纸张上有公式，引用组合纸张。

在合并代码中，组合的工作表如果存在则被删除，然后再次添加。这会弄乱所有的公式参考。我想删除删除并重新添加组合工作表的部分，而是清除工作表的内容然后合并数据。

这是我到目前为止的代码。

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

Answer 1

我认为应该这样做。我假设公式在其他工作表上并参考目的地表？这段代码确实假设你有一个＆＃34; combinedreport＆＃34;表单开头。

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

清除工作表的内容

1 个答案: