2017-08-14 136 views
-1

我有一个合并工作表的宏。当条目被添加到单个工作表时,我希望刷新组合工作表。清除工作表内容

我在其他工作表上引用组合工作表的公式。

在组合代码中,如果存在组合纸张,则会删除组合纸张,然后再次添加。这混淆了所有的公式引用。我想删除删除并重新添加组合工作表的部分,而是清除工作表内容,然后合并数据。

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

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 
+1

如果您已经打开了一个问题,那么发布一个副本而不提及现有的帖子是有点不考虑的... –

回答

0

我认为这应该做到这一点。我假设公式在其他工作表上,并参考目标工作表?这段代码确实假设你有一个“combined report”工作表。

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