Conditional copying a row and inserting a new row

Hello "Forever Lost". The code below will copy columns B-P (from all the worksheets after your "New Listing" worksheet) in to a worksheet named "New Listing" (in columns B-P). NOTE - this code assumes your "New Listing" worksheet is the first worksheet in your workbook.

Sub CopyNew()
' Written by Barrie Davidson

Dim WorkingSheet As String
Dim i As Long
Dim Rowi As Long

On Error Resume Next
Sheets("New Listing").Select
Range("B65536").End(xlUp).Offset(1, 0).Select
If Selection.Row = 2 And Range("A1").Value = "" Then Selection.Offset(-1, 0).Select
Rowi = 0
For i = 1 To ActiveWorkbook.Sheets.Count - 1
ActiveSheet.Next.Select
Range("A1").Select
Cells.Find(What:="new", _
After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If UCase(Selection.Value) = "NEW" Then
Do Until Selection.Row < Rowi
Rowi = Selection.Row
WorkingSheet = ActiveSheet.Name
Selection.Offset(0, 1).Range("A1:O1").Copy
Sheets("New Listing").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Activate
Sheets(WorkingSheet).Select
Cells.Find(What:="new", _
After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False) _
.Activate
Loop
Rowi = 0
End If
Next i

End Sub

Hope this helps you out.

Regards,
BarrieBarrie Davidson

Thanks Barrie! One question though. Is there a way for the "New Listing" Worksheet to be the last in the workbook? This new listing sheet is more like a report done at the end of the inventory. If it is up front then people would get confused. Even though they wouldn't need to use it because it is more for the inventory manager. I'm trying to make it as easy as possible for the people doing the counting.

Thanks again!
Eric

Eric, try this code instead.

Sub CopyNew()
' Written by Barrie Davidson

Dim WorkingSheet As String
Dim i As Long
Dim Rowi As Long

On Error Resume Next
Sheets("New Listing").Select
Range("B65536").End(xlUp).Offset(1, 0).Select
If Selection.Row = 2 And Range("A1").Value = "" Then Selection.Offset(-1, 0).Select
Rowi = 0
For i = 1 To ActiveWorkbook.Sheets.Count - 1
Sheets(i).Select
Range("A1").Select
Cells.Find(What:="new", _
After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If UCase(Selection.Value) = "NEW" Then
Do Until Selection.Row < Rowi
Rowi = Selection.Row
WorkingSheet = ActiveSheet.Name
Selection.Offset(0, 1).Range("A1:O1").Copy
Sheets("New Listing").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Activate
Sheets(WorkingSheet).Select
Cells.Find(What:="new", _
After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False) _
.Activate
Loop
Rowi = 0
End If
Next i
Sheets("New Listing").Select

End Sub

Regards,
Barrie Thanks Barrie! One question though. Is there a way for the "New Listing" Worksheet to be the last in the workbook? This new listing sheet is more like a report done at the end of the inventory. If it is up front then people would get confused. Even though they wouldn't need to use it because it is more for the inventory manager. I'm trying to make it as easy as possible for the people doing the counting. Thanks again!

Barrie Davidson

Doesn't seem to work. It keeps pasting the same couple of cells over and over. The cells don't contain the word "new" in them. It keeps pasting Manager and his name. The rows that could contain new are about 7 rows down. I tried it with both versions you sent me and they both do they same thing.

Thanks again for your help.
Eric Eric, try this code instead.

Eric, can you e-mail a copy of the file (with any confidential info taken out) and I'll have a look at it when I get home tonight from work? FYI - it's 4:30 pm here right now.

Barrie

Barrie Davidson