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