ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Copy Rows if Cell F? contains (https://www.excelbanter.com/excel-programming/344259-copy-rows-if-cell-f-contains.html)

Hal[_4_]

Copy Rows if Cell F? contains
 
My sheet has 200+ rows of data in columns A - P. I want to search the text in
column F cells for 'myString' and copy those rows in another worksheet, same
workbook. Row A is a header row.

Your assistance is greatly appreciated as always.

Hal

Tom Ogilvy

Copy Rows if Cell F? contains
 
Dim rng as Range
Dim rw as Long
Dim cell as Range
set rng = range(cells(2,6),cells(rows.count,6).End(xlup))
rw = 2
for each cell in rng
if instr(1,cell,"myString",vbTextCompare) then
Cells(cell.row,1).Resize(1,16).copy _
Destination:=Worksheets("Sheet2").Cells(rw,1)
rw = rw + 1
end if
Next

--
Regards,
Tom Ogilvy

"Hal" wrote in message
...
My sheet has 200+ rows of data in columns A - P. I want to search the text

in
column F cells for 'myString' and copy those rows in another worksheet,

same
workbook. Row A is a header row.

Your assistance is greatly appreciated as always.

Hal




Norman Jones

Copy Rows if Cell F? contains
 
Hi Hal,

Try something like:

'================
Public Sub CopyRange()
Dim Rng As Range
Dim rCell As Range
Dim copyRng As Range
Dim destRng As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim LRow As Long
Dim CalcMode As Long
Const sStr As String = '"ABCD" '<<==== CHANGE

Set WB = ActiveWorkbook '<<==== CHANGE
Set SH = WB.Sheets("Sheet1") '<<==== CHANGE
Set destRng = WB.Sheets("Sheet2").Range("A2") '<<==== CHANGE

LRow = Cells(Rows.Count, "A").End(xlUp).Row

Set Rng = SH.Range("F2:F" & LRow)

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each rCell In Rng.Cells
If InStr(1, rCell, sStr, vbTextCompare) 0 Then
If copyRng Is Nothing Then
Set copyRng = rCell
Else
Set copyRng = Union(rCell, copyRng)
End If
End If
Next rCell

If Not copyRng Is Nothing Then
copyRng.EntireRow.Copy Destination:=destRng
Else
'nothing found, do nothing
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'<<================


---
Regards,
Norman



"Hal" wrote in message
...
My sheet has 200+ rows of data in columns A - P. I want to search the text
in
column F cells for 'myString' and copy those rows in another worksheet,
same
workbook. Row A is a header row.

Your assistance is greatly appreciated as always.

Hal





All times are GMT +1. The time now is 04:14 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com