Search column - move/copy entire row into another sheet.

[Maximilian]

Hello!

Ive been trying to figure out how to make this work for a while now, so I'll give you guys a try!:)

I have a list of facts in Sheet1 from column A-Q and row 1-5000.

In column E im going to write different words as I go down the list. Lets just say that the word will be "Yes" or "No".

I want a macro that will copy all the rows with the word "Yes" in, into Sheet2.

I have found a way that works, but the problem is that this will copy into row 2 in sheet 2 always. So, lets say i change some of the info on Sheet2 and after a week i use the macro again. This will make the macro overwrite the changes ive done.

Not sure if you guys understand what im trying to say here, but I hope so!.


I would like a macro that MOVE the row, instead of Copy/paste it. This will make the number of rows on Sheet1 grow smaller, and I can change the info as i go down the list on sheet2.


I hope you get what im asking.

Below is the macro im using now:





Sub Makro1()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

LSearchRow = 2
LCopyToRow = 2


While Len(Range("A" & CStr(LSearchRow)).Value) > 0

If Range("E" & CStr(LSearchRow)).Value = "YES" Then

Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

LCopyToRow = LCopyToRow + 1

Sheets("Sheet1").Select

End If

LSearchRow = LSearchRow + 1

Wend

Application.CutCopyMode = False
Sheets("Sheet1").Select

Exit Sub

Err_Execute:
MsgBox "An error occurred. Number: " & Err.Number & " Description: " & Err.Description

End Sub

[oldman]

You are more advanced than I am; however, I believe you need something like:



With Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp) . . .


POSSIBLY after "Selection.Copy" and in lieu of "Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste"

[SamT]

Hey Maximillian, Welcome to the forum.

The OldMan is right, change LCopyToRow = 2, to
LCopyToRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1

There are a couple of small problems with the Code as is. Let me ask you; How many Rows are in a sheet? What is the limitation on Integers? Answers: Dim the all Row and Column Variables as Long.

VBA is really smart, it knows that all Range assignments have to be Strings and all Cell assignments have to be Longs. That means that you can use them interchangably.
Range("A" & LCopyToRow)
'And
Cells(LCopyToRow, "A")

If we declare a new variable "i" as a Long, we can get rid of that CPU process eating While-Wend statement and use a simple counting loop.
For i = 2 to Cells(Rows.Count, 1).End(xlUp).Row
'
'
'
Next i

Here is how I would have written the entire code
Sub Makro1()

Dim CopySht As Worksheet
Dim LastRow As Long
Dim PasteSht As Worksheet
Dim PasteRow As Long
Dim i As Long

Set CopySht = Sheets("Sheet1")
Set PasteSht = Sheets("Sheet2")
PasteRow = PasteSht.Cells(Rows.Count, "A").End(xlUp).Row + 1 'Compare to: .End(xlUp).Offset(1, 0).Row
LastRow = CopySht.Cells(Rows.Count, "A").End(xlUp).Row

On Error GoTo OOPS

For i = 2 To LastRow
If LCase(CopySht.Range("E" & i).Value) = "yes" Then
'Compare to: If Right(LCase(CopySht.Range("E" & i).Value), 1) = "y"
'Assume col "E" value = "True". Compare to: If CopySht.Range("E" & i).Value Then
CopySht.Rows(i).Copy Destination:=PasteSheet.Cells(PasteRow, 1)
CopySht.Rows(i).Delete
i = i - 1 'We just deleted a row.
LastRow = LastRow - 1
PasteRow = PasteRow + 1
End If
Next i

Application.CutCopyMode = False
Exit Sub

OOPS:
MsgBox "An error occurred. Number: " & Err.Number & "; Description: " & Err.Description
End Sub

[oldman]

Nice touch Sam!