2017-08-14 4 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

私はこれを行うべきだと思います。私は数式が他のシートにあると仮定し、宛先シートを参照してください?このコードでは、 "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 
関連する問題