Code to move rows to a new sheet.

dandee14k

New Member
Joined
Dec 1, 2023
Messages
8
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Instead of specifying destination in xRg(C).EntireRow.Copy Destination.......

Use
VBA Code:
xRg(C).EntireRow.Copy
Worksheets("Archive (Sea)").Range("A" & B + 1).PasteSpecial Paste:=xlPasteValues
 
Upvote 0
Solution
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.
 
Upvote 0
Instead of specifying destination in xRg(C).EntireRow.Copy Destination.......

Use
VBA Code:
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 :)
 
Upvote 1
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
VBA Code:
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
VBA Code:
xRg(C).EntireRow.Copy
Worksheets("Archive (Sea)").Range("A" & B + 1).PasteSpecial Paste:=xlPasteValues
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top