3

I have a workbook "DATABASE" with 5 sheets, I am trying to let my code copy contents of all 4 sheets and paste it to one master sheet "ARCHIVE" to be all together compiled.

I want each time the code runs, to clear contents in ARCHIVE and then paste copied values from other sheets. So that there will be no duplication every time is runs.

the code works fine before the clear thing, but when I add activesheets.cells.clearcontents or sheets("ARCHIVE").cells.clearcontents after the sheets("ARCHIVE").activate it doesn't work.

can someone help me where exactly should I put the clear contents code for ARCHIVE sheet before pasting? and if I should declare something before?

I have put here the code while its working properly without the clear thing:

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
  • you want to clear all values then paste values from each sheet each time in the sheet "Archive"? – k1dr0ck May 20 '23 at 08:34
  • 1
    **1.** You do not need a timer **2.** In your loop, you need to account for the `ARCHIVE` sheet as well. **3.** Avoid the use of `.Select` and `.Activate`. You may want to see [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) – Siddharth Rout May 20 '23 at 08:39
  • 1
    I don't see the line where you are clearing contents. If you copy a range then clear contents, you are out of the copy command, so when you paste, there will be nothing to paste – Davesexcel May 20 '23 at 09:25
  • Yes, as I mentioned in my explanation that I have put my code without the clear function as I don't know where I should put it exactly. I explained that I want my code to copy from other sheets and paste into one master sheet, but I want it to clear the one master sheet every time before pasting. and therefore, I don't know where it is appropriate to put the clear function. – Funny Memo Ms May 20 '23 at 09:58
  • 1
    Yes, as I mentioned in my explanation, if you copy something then clear contents, the copy command no longer exists. You need to clear contents before you copy. – Davesexcel May 20 '23 at 10:38

2 Answers2

3

try

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
  • 1,043
  • 4
  • 13
3

Copy to Master Worksheet

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
  • 44,888
  • 5
  • 17
  • 28