Excel宏:用于组合特定工作表中的数据和刷新的代码?

时间:2017-08-14 16:22:46

标签: excel excel-vba vba

我有一张大约有20张的工作簿。其中11个基于数据的表具有外部连接,当添加条目并刷新工作簿时,外部连接会更新并添加数据行。其他工作表是表格和图表的表格。我正在尝试使用vba将11张基于数据的工作表中的数据合并到一张工作表中,然后将更多条目添加到单独的11张工作表中,然后组合工作表刷新和更新。

我有一个结合了特定11张的代码,但是,我需要有关刷新部分的帮助。我尝试添加一个可以重新运行代码的按钮,但它会删除并重新添加一个组合表单,这会混淆我公式中的所有引用。我希望有人能够重新编写一些代码,以便合并后的表格不会被删除,并且不需要添加新的表格,这样数据就可以了更新到组合表中而不会搞砸引用。

感谢。

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

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").Cells.ClearContents
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

0 个答案:

没有答案