清除粘贴前的内容

Question

我有一个名为“DATABASE”的工作簿，其中包含5个工作表，我正在尝试让我的代码复制所有4个工作表的内容并将其粘贴到一个主工作表“ARCHIVE”中，以便全部编译在一起。

每次运行代码时，我希望清除ARCHIVE中的内容，然后将其他工作表中复制的值粘贴到其中。这样每次运行时就不会重复。

在清除之前，代码可以正常工作，但是当我在sheets("ARCHIVE").activate之后添加activesheets.cells.clearcontents或sheets("ARCHIVE").cells.clearcontents时，它就无法正常工作了。

请问有人能帮我确定应该在何处放置ARCHIVE工作表的清除内容代码，并且是否需要在此之前声明某些内容？

以下是代码示例，没有清除内容时可以正常工作：

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

- Funny Memo Ms

---

你想要清除所有数值，然后每次从每个工作表中粘贴数值到“归档”工作表中吗？ - k1dr0ck

1. 你不需要一个计时器。
2. 在你的循环中，你也需要考虑到“ARCHIVE”工作表。
3. 避免使用.Select和.Activate。你可能想看一下如何在Excel VBA中避免使用Select。

- Siddharth Rout

我没有看到你清除内容的那一行。如果你复制了一个区域然后清除了内容，你就已经退出了复制命令，所以当你粘贴时，就没有任何东西可以粘贴了。 - Davesexcel

是的，正如我在解释中提到的那样，我已经放置了我的代码，但没有清除函数，因为我不知道应该把它放在哪里。我解释说，我希望我的代码从其他工作表复制并粘贴到一个主工作表中，但我希望在每次粘贴之前清除一次主工作表。因此，我不知道何时适合放置清除函数。 - Funny Memo Ms

是的，正如我在解释中提到的那样，如果你复制了某些内容然后清除了它们，复制命令就不存在了。你需要在复制之前清除内容。 - Davesexcel

Answer 1

尝试

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

- k1dr0ck

Answer 2

复制到主工作表

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

- VBasic2008

---

抱歉，代码有一些错误。我已经进行了编辑，现在应该可以正常工作了。 - VBasic2008