Macro to move rows to another sheet

I am looking for a macro that moves all rows that begin with "Prod: DCA1 " in the Problem Summary/Subject column which is the second column in the "Current" worksheet to the tab that is labeled "Dial-Homes". They have the same column headers in both these worksheets. I am looking to move all the data with the rows from columns A to N since there are formulas in the columns to the right of that.
AckeemKAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rodney EndrigaData AnalystCommented:
AckeemK, you can try this code:

Sub ee_MoveData2Sheet()

Dim wsCurrent As Worksheet, wsDialHomes As Worksheet, l As Long
Application.ScreenUpdating = False
Set wsCurrent = Sheets("Current")
Set wsDialHomes = Sheets("Dial-Homes")

l = Cells(Rows.Count, "B").End(xlUp).Row
For x = 1 To l
    If Left(Cells(x, 2).Value, 10) = "Prod: DCA1" Then
        Cells(x, 2).EntireRow.Cut wsDialHomes.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        Cells(x, 2).EntireRow.Delete Shift:=xlUp
        x = x - 1
    End If
Next x
Application.ScreenUpdating = True

End Sub

Open in new window


You will have to adjust the Sheetnames or Column names to match your actual workbook. But this code will move the rows between sheets based on the criteria you provided.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
AckeemKAuthor Commented:
This worked perfectly! I was looking to have this macro run right after another one but for some reason it's not working. Any help here?

Sub changestatus()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim lr As Long
    Dim cell As Range, rng As Range
    Dim ws As Worksheet, lr1 As Long
    Dim r As Range, ws1 As Worksheet
    
    With Sheets("Current").UsedRange.Offset(1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
        End With
        
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Closed")
    lr = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    If lr > 1 Then

        Set rng = ws.Range("E2:E" & lr)

        For Each cell In rng
            lr1 = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1


            If InStr(1, cell.Value, "Solved", vbTextCompare) Or InStr(1, cell.Value, "closed", vbTextCompare) > 0 Then
                cell.EntireRow.Copy ws1.Range("A" & lr1)

                If r Is Nothing Then

                    Set r = cell
                Else
                    Set r = Union(cell, r)
                End If
            End If

        Next cell
        If Not r Is Nothing Then r.EntireRow.Delete

    End If

    Set ws = Sheets("Import")
    lr = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    If lr > 1 Then

        Set rng = ws.Range("E2:E" & lr)

        For Each cell In rng

            If InStr(1, cell.Value, "open", vbTextCompare) > 0 Then cell.Value = "Open"
        Next cell


    End If
    
       For Each sht In ThisWorkbook.Worksheets
        Select Case sht.Name
        Case "Import"
            With sht
                .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 100).Delete
            End With
        End Select
Next
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


End Sub

Sub ee_MoveData2Sheet()

Dim wsCurrent As Worksheet, wsDialHomes As Worksheet, l As Long
Application.ScreenUpdating = False
Set wsCurrent = Sheets("Current")
Set wsDialHomes = Sheets("Dial-Homes")

l = Cells(Rows.Count, "B").End(xlUp).Row
For x = 1 To l
    If Left(Cells(x, 2).Value, 10) = "Prod: DCA1" Then
        Cells(x, 2).EntireRow.Cut wsDialHomes.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        Cells(x, 2).EntireRow.Delete Shift:=xlUp
        x = x - 1
    End If
Next x
Application.ScreenUpdating = True

End Sub

Open in new window

0
Rodney EndrigaData AnalystCommented:
Enter this name "ee_MoveData2Sheet" in LINE#70 of your code.

The MOVEDATA will begin after the CHANGESTATUS macro has performed its steps.
0
The 7 Worst Nightmares of a Sysadmin

Fear not! To defend your business’ IT systems we’re going to shine a light on the seven most sinister terrors that haunt sysadmins. That way you can be sure there’s nothing in your stack waiting to go bump in the night.

AckeemKAuthor Commented:
For some reason, it doesn't seem to be working. I've attached the reporting tool where I have placed the macro in. On the 'Table of Contents' tab, I placed this macro in the "Update Links" button but it doesn't seem to be moving those rows to the 'Dial-Homes' tab.
DSE-Carelog-Report-V1.xlsm
0
Rodney EndrigaData AnalystCommented:
Ok, I have adjusted the code a bit to ensure it looks at the proper sheets.

Let me know if this works for you.
DSE-Carelog-Report-V1.xlsm
0
AckeemKAuthor Commented:
Hi Rodney,

This works perfectly and I appreciate it!
0
Rodney EndrigaData AnalystCommented:
Glad to assist!

For the future, try to include a sample workbook as a template with your questions. If you cannot upload the 'actual data', try to create a sample of the data to work with. It may be easier for the Experts to come up with the solution you seek. :D Happy coding!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.