excel 粘贴前清除内容

oknwwptz 于 2023-05-23 发布在其他

关注(0)|答案(2)|浏览(216)

我有一个工作簿“数据库”与5张，我试图让我的代码复制所有4张的内容，并将其粘贴到一个主表“存档”一起编译。
我希望每次代码运行时，清除ARCHIVE中的内容，然后粘贴从其他工作表复制的值。以便每次运行时都不会出现重复。
代码在clear之前工作正常，但是当我在sheets("ARCHIVE").activate之后添加activesheets.cells.clearcontents或sheets("ARCHIVE").cells.clearcontents时，它就不工作了。
有人可以帮助我在粘贴之前，我应该把明确的内容代码存档工作表？我是否应该提前申报？
我把代码放在这里，而它的工作正常，没有明确的事情：

Sub CopyToMaster()
 
ShtCount = ActiveWorkbook.Sheets.Count
 
For I = 2 To ShtCount
 
Worksheets(I).Activate
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
 
Range("a2:N" & LastRow).Select
 
Selection.Copy
Sheets("ARCHIVE").Activate
 
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Select
 
'Required after first paste to shift active cell down one
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
 
ActiveCell.Offset(0, 0).Select
Selection.PasteSpecial
ActiveWorkbook.Save

 
Next I
End Sub

Sub tensecondstimer()

Application.OnTime Now + TimeValue("00:00:10"), "CopyToMaster"

End Sub

excel

来源：https://stackoverflow.com/questions/76293826/clear-contents-before-paste

2条答案

按热度按时间

bjp0bcyl1#

尝试

Sub CopyToMaster()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim archiveSheet As Worksheet
    Dim lastRow As Long, archiveLastRow As Long, ShtCount As Long, i As Long
    
    Set wb = ActiveWorkbook
    Set archiveSheet = wb.Sheets("ARCHIVE")
    ShtCount = wb.Sheets.Count

    For i = 2 To ShtCount
            If i = 2 Then archiveSheet.Cells.ClearContents
            lastRow = Worksheets(i).Cells(Worksheets(i).Rows.Count, "A").End(xlUp).Row
            archiveLastRow = archiveSheet.Cells(archiveSheet.Rows.Count, "A").End(xlUp).Row
            Worksheets(i).Range("A2:N" & lastRow).Copy
            archiveSheet.Cells(archiveLastRow + 1, "A").PasteSpecial Paste:=xlPasteValues
    Next i
    
    wb.Save
    
    Set wb = Nothing
    Set ws = Nothing
    Set archiveSheet = Nothing
    
    tensecondstimer
End Sub

Sub tensecondstimer()
   Application.OnTime Now + TimeValue("00:00:10"), "CopyToMaster"
End Sub

赞(0）回复(0）举报 2023-05-23

yfjy0ee72#

复制到主工作表

Option Explicit

Sub CopyToMaster()
 
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Archive")

    Dim dfCell As Range
     
    With dws.UsedRange
        On Error Resume Next ' prevent error if no data
            .Resize(.Rows.Count - 1).Offset(1).Clear ' all except headers
        On Error GoTo 0
        Set dfCell = .Cells(1).Offset(1) ' first destination cell ("A2")
    End With

    Dim sws As Worksheet, srg As Range
    
    For Each sws In wb.Worksheets
        If Not sws Is dws Then ' exclude destination worksheet
            With sws.UsedRange
                On Error Resume Next ' prevent error if no data
                    Set srg = .Resize(.Rows.Count - 1).Offset(1)
                On Error GoTo 0
            End With
            If Not srg Is Nothing Then
                srg.Copy dfCell
                Set dfCell = dfCell.Offset(srg.Rows.Count) ' next first cell
                Set srg = Nothing ' reset for the next iteration
            End If
        End If
    Next sws

    wb.Save
    
End Sub

赞(0）回复(0）举报 2023-05-23

我来回答

excel 粘贴前清除内容

2条答案

复制到主工作表

相关问题

热门标签

最新问答