Macro to move cells to another worksheet and overwrite existing data in the target worksheet

[Jamie6325]

I have a VBA code to move rows in the "Data" worksheet to another sheet, "Active Status" based on the status in Column A. The "Data" spreadsheet will be modified by users on a daily basis. The status may change from Active to Non-Active and other information may be added. I need help regarding moving the rows in the worksheet "Data" to the "Active Status" worksheet and overwriting the data that is currently in the "Active Status" worksheet. Any suggestions? My current code keeps adding to the rows to the "Active Status" worksheet and not overwriting them. That is the part that I cannot figure out.

Below is an example of the data and the VBA code I am currently using.

Sub MoveActive()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Data").UsedRange.Rows.Count
J = Worksheets("Active Status").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Active SH Referrals").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Data").Range("A1:C" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Active Status" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Active Status").Range("A" & J)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub


Sample of data:

Active Status	Date	Month	Year	Day of the Week	Name
Active	7/12/2022	July	2022	Tuesday	xxxxx
Non Active	7/12/2022	July	2022	Tuesday	xxxxx
Active	7/23/2022	July	2022	Saturday	xxxxx

 

[mumps]

Try:

Sub MoveRows()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Data")
    Set desWS = Sheets("Active Status")
    desWS.UsedRange.Offset(1).ClearContents
    With srcWS
        .Range("A1").CurrentRegion.AutoFilter 1, "Active"
        .AutoFilter.Range.Offset(1).Copy desWS.Range("A2")
        .Range("A1").AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[Jamie6325]

.AutoFilter.Range.Offset(1).Copy desWS.Range("A2")

I get an error on this line.

 

[mumps]

What was the error message and which line of code was highlighted when you clicked debug?

 

[Jamie6325]

I get the following:
Run-time error '1004':
Application-defined or object-defined error

 

[mumps]

When you click Debug, which line of code is highlighted?

 

[Jamie6325]

.AutoFilter.Range.Offset(1).Copy desWS.Range("A2")

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[Jamie6325]

Active Status.xlsm

Shared with Dropbox

www.dropbox.com

Explain in detail what you want to do referring to specific cells, rows, columns and sheets:

If any cell in column A in the 'Data' sheet contains the word "Active", I would like to copy and move the entire row to another sheet called 'Active' starting in A3. If you look at the spreadsheet, it will be easier. The current macro I am using will copy and move the rows to the 'Active' sheet but it does not overwrite the data that is in the 'Active' sheet, it just adds on to it. Every time I run the macro, I would like the data to overwrite whatever is in the 'Active' sheet starting at A3 and not continue to add rows at the bottom.

 

[mumps]

Try:

Sub MoveRows()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Data")
    Set desWS = Sheets("Active Status")
    desWS.UsedRange.Offset(1).ClearContents
    With srcWS.ListObjects("Table1")
        .Range.AutoFilter Field:=1, Criteria1:="Active"
        .AutoFilter.Range.Offset(1).Copy desWS.Range("A2")
        Range("A2").AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub