Code to move rows to a new sheet.

[dandee14k]

Hello,

I have the below code for moving an entire row to another sheet, it works fine but I just need a bit of help changing something if possible.

it currently moves the rows to the new sheet but it it also copies the formulas and is causing to return errors, #VALUE!.

is there a way that maybe when the data gets copied to the new sheet it pastes it as special values only to removed the formulas but retain the data?

please help me.

Sub MoveCellsSEA()
    
    Dim xRg As Range

    Dim xCell As Range

    Dim A As Long

    Dim B As Long

    Dim C As Long

    A = Worksheets("Files to Make Up (Sea) ").UsedRange.Rows.Count
    B = Worksheets("Archive (Sea)").UsedRange.Rows.Count
    If B = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Archive (Sea)").UsedRange) = 0 Then B = 0
    End If
    Set xRg = Worksheets("Files to Make Up (Sea) ").Range("A2:AG" & A)
    On Error Resume Next
    Application.ScreenUpdating = False
    For C = 1 To xRg.Count
        If CStr(xRg(C).Value) = "Completed" Then
            xRg(C).EntireRow.COPY Destination:=Worksheets("Archive (Sea)").Range("A" & B + 1)
            xRg(C).EntireRow.Delete
            If CStr(xRg(C).Value) <> "" = "Completed" Then
                C = C - 1
                            End If
            B = B + 1
        End If
    Next
    Application.ScreenUpdating  =  True

End Sub

 

[MountainFog]

Instead of specifying destination in xRg(C).EntireRow.Copy Destination.......

Use

xRg(C).EntireRow.Copy
Worksheets("Archive (Sea)").Range("A" & B + 1).PasteSpecial Paste:=xlPasteValues

 

[jolivanes]

If you had to rephrase your request without showing code that does not do what you want, what would it be?
I am thinking along the lines of:
"If the value of a cell in Column G is "Completed" then move row to another sheet and delete the original row."
Or something similar.

 

[dandee14k]

Instead of specifying destination in xRg(C).EntireRow.Copy Destination.......

Use

xRg(C).EntireRow.Copy
Worksheets("Archive (Sea)").Range("A" & B + 1).PasteSpecial Paste:=xlPasteValues

Thank you so much, this is brilliant, it works perfectly now

 

[dandee14k]

Hello me again,

I thought maybe you can help me with something else.

So basically now that, my first code works perfectly thanks to the solution provided, I can archive anything that has "completed" to a new sheet. (works brilliantly btw )

I was thinking is there a way that the same can be done but instead to move it to a sheet within the same workbook, it actually moves it to a new workbook?, IE. Workbook 1 = Files to Make Up (Sea), Workbook 2 = Archive 2024 (this is the new workbook).

Just being conscious that once the current archive sheet will get to big and it will slowdown the sheet from open it.

Please let me know if this is possible, thanks again in advance.

Other option is archive the archive

Sub MoveCellsSEA()
    
    Dim xRg As Range

    Dim xCell As Range

    Dim A As Long

    Dim B As Long

    Dim C As Long

    A = Worksheets("Files to Make Up (Sea) ").UsedRange.Rows.Count
    B = Worksheets("Archive (Sea)").UsedRange.Rows.Count
    If B = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Archive (Sea)").UsedRange) = 0 Then B = 0
    End If
    Set xRg = Worksheets("Files to Make Up (Sea) ").Range("A2:AG" & A)
    On Error Resume Next
    Application.ScreenUpdating = False
    For C = 1 To xRg.Count
        If CStr(xRg(C).Value) = "Completed" Then
            xRg(C).EntireRow.COPY
            Worksheets("Archive (Sea)").Range("A" & B + 1).PasteSpecial Paste:=xlPasteValues
            xRg(C).EntireRow.Delete
            If CStr(xRg(C).Value) <> "" = "Completed" Then
                C = C - 1
                            End If
            B = B + 1
        End If
    Next
    Application.ScreenUpdating  =  True

End Sub

Instead of specifying destination in xRg(C).EntireRow.Copy Destination.......

Use

xRg(C).EntireRow.Copy
Worksheets("Archive (Sea)").Range("A" & B + 1).PasteSpecial Paste:=xlPasteValues