Cut/Paste to new Worksheet

[gzell]

I am trying to move row of data from one worksheet to another worksheet based on value of cells in Column E. Cells with (Age), (Residence), (Enrolled), or (Enlisted) would move entire row to new worksheet and delete row in original worksheet. Example worksheet below, I truly appreciate any help that could be offered.

A B C D E F G H

Service_Detail_ID​	Person_ID​	Record_Detail_ID​	Related_Record_ID​	Record_Type_Name​	Record_Date_Begin​	Record_Date_End​	Record_Location​
1​	1​	1_7​		Age​
2​	1​	1_8​		Residence​
3​	1​	1_9​		Enrolled​			Buchanan Johnson County Texas​
4​	1​	1_11​		Enlisted​	October 25 1861​		Houston Texas​
5​	1​	2_1​		Detail​	November 8 1861​	February 4 1862​	Texas​
6​	1​	3_1​		Relieved of Duty​	February 4 1862​		Texas​
7​	1​	4_1​		Furloughed​	August 1862​	September 1862​	Texas​
8​	1​	2_1​	10​	Captured​	January 11 1863​		Battle of Arkansas Post​
9​	1​	2_3​	10​	Forwarded via Ship​	January 12 1863​	January 13 1863​	St. Louis Missouri​
10​	1​	2_4​	10​	Forwarded via Rail​	January 27 1863​		Camp Douglas Illinois​
11​	1​	2_5​	10​	Prisoner​	January 30 1863​		Camp Douglas Illinois​
12​	1​	15_1​		Died​	March 9 1863​		Camp Douglas Illinois​
13​	2​	1_7​		Age​
14​	2​	1_8​		Residence​
15​	2​	1_9​		Enrolled​			Kimball County Texas​
16​	2​	1_11​		Enlisted​	January 16 1862​		Millican Brazos County Texas​
17​	2​	2_1​	11​	Captured​	January 11 1863​		Battle Arkansas Post Arkansas​
18​	2​	2_3​	11​	Forwarded via Ship​	January 12 1863​	January 13 1863​	St. Louis Missouri​
19​	2​	2_4​	11​	Forwarded via Rail​	January 27 1863​		Camp Douglas Illinois​
20​	2​	2_5​	11​	Prisoner​	January 30 1863​		Camp Douglas Illinois​
21​	2​	2_6​	11​	Forwarded for Exchanged​	April 7 1863​		City Point Virginia​
22​	2​	2_7​	11​	Exchanged​	April 10 1863​		City Point Virginia​
23​	2​	6_10​		Hospital​	March 22 1864​		Kingston Georgia​
24​	2​	2_1​	12​	Captured​	November 30 1864​		Battle of Franklin​
25​	2​	2_3​	12​	Forwarded​			Nashville Tennessee​
26​	2​	2_4​	12​	Forwarded via Rail​	December 2 1864​		Louisville Kentucky​
27​	2​	2_5​	12​	Prisoner​	December 3 1864​		Louisville Kentucky​
28​	2​	2_4​	12​	Forwarded via Rail​	December 3 1863​		Camp Douglas Illinois​
29​	2​	2_5​	12​	Prisoner​	December 6 1863​		Camp Douglas Illinois​
30​	2​	5_1​	12​	Oath of Allegiance​	June 18 1865​		Camp Douglas Illinois​
31​	2​	13_1​	12​	Discharged​	June 18 1865​		Camp Douglas Illinois​
32​	2​	15_1​		Died​	July 4 1905​		Indian Territory Oklahoma​
33​	3​	1_7​		Age​
34​	3​	1_8​		Residence​
35​	3​	1_9​		Enrolled​	October 26 1861​		Fairfield Freestone County Texas​
36​	3​	1_11​		Enlisted​	October 31 1863​		Hempstead Texas​
37​	3​	10_1​		Absent​	January 1862​	April 1864​
38​	3​	11_1​		Transferred​	February 3 1863​
39​	3​	11_2​		Unit​
40​	4​	1_7​		Age​
41​	4​	1_8​		Residence​
42​	4​	1_9​		Enrolled​
43​	4​	1_11​		Enlisted​	April 1 1862​		Camp Brazos Texas​
44​	4​	2_10​		Hospital​	June 17 1862​		Brownsville Arkansas​
45​	4​	10_1​		Absent​	January 1863​	April 1864​
46​	4​	11_1​		Transferred​	February 3 1863​

 

[Zot]

Try this

Sub MoveDelete()

Dim m As Long, n As Long
Dim cell As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Application.ScreenUpdating = False

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

m = 2
n = 1
Do While Not Len(ws1.Range("A" & m)) = 0
    Select Case ws1.Range("E" & m)
        Case "Age", "Residence", "Enrolled", "Enlisted"
            n = n + 1
            With ws1.Range("A" & m).EntireRow
                .Copy ws2.Range("A" & n)
                .Delete
            End With
        Case Else
            m = m + 1
    End Select
Loop

End Sub

 

[gzell]

Try this

Sub MoveDelete()

Dim m As Long, n As Long
Dim cell As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Application.ScreenUpdating = False

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

m = 2
n = 1
Do While Not Len(ws1.Range("A" & m)) = 0
    Select Case ws1.Range("E" & m)
        Case "Age", "Residence", "Enrolled", "Enlisted"
            n = n + 1
            With ws1.Range("A" & m).EntireRow
                .Copy ws2.Range("A" & n)
                .Delete
            End With
        Case Else
            m = m + 1
    End Select
Loop

End Sub

Thank you for the help. Worked great.

 

[gzell]

Try this

Sub MoveDelete()

Dim m As Long, n As Long
Dim cell As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Application.ScreenUpdating = False

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

m = 2
n = 1
Do While Not Len(ws1.Range("A" & m)) = 0
    Select Case ws1.Range("E" & m)
        Case "Age", "Residence", "Enrolled", "Enlisted"
            n = n + 1
            With ws1.Range("A" & m).EntireRow
                .Copy ws2.Range("A" & n)
                .Delete
            End With
        Case Else
            m = m + 1
    End Select
Loop

End Sub

Thanks for the help. Worked great