Copying rows

[vincentvega]

Hi

I want to copy rows from a source sheet to a new sheet. I looked at a
example found here @ the excelforum, plse find below, but i need t
copy based on a matching text string.

For example, if a certain column, say column C, would hold occurence
of the word "apple", say in cells C3 to C5 and C8, then only the row
containing "apple" need to be copied across into the new sheet, i.e
rows 3,4,5 and 8.

Any suggestions on how i can do this?


Sub CopyRowValues()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Lr = LastRow(Sheets("Sheet2")) + 1
Set sourceRange = Sheets("Sheet1").Rows("1:1")
Set destrange = Sheets("Sheet2").Rows(Lr). _
Resize(sourceRange.Rows.Count)
destrange.Value = sourceRange.Value
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Functio

 

[Patrick Molloy]

This is a start for you. It sets the autofilter on row 1 , which i'd assume
are headers, sets the criteria as passed and copies the filtered rows to a
new worksheet...paste the following into a new standard module

Option Explicit

Sub Test()
CopyRows "Apple"
End Sub
Private Sub CopyRows(Text As String)
Dim ws As Worksheet

With Sheet1 'ActiveSheet
.Range("A1:M1").AutoFilter
.Range("A1:M1").AutoFilter Field:=3, _
Criteria1:=Text
.Cells.SpecialCells(xlCellTypeVisible).Rows.Copy

Set ws = Worksheets.Add
ws.Range("A1").PasteSpecial xlPasteAll

Application.CutCopyMode = False
.Range("A1:M1").AutoFilter
End With
End Sub