• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2712
  • Last Modified:

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.
0
AckeemK
Asked:
AckeemK
  • 4
  • 3
1 Solution
 
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
 
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
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

 
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now