Link to home
Start Free TrialLog in
Avatar of sandramac
sandramac

asked on

Extract a Cell Data

I have a data in column a from row 1 to row 288, I need to find the cell that has the words "OPEN END MORTGAGE DEED" and copy that cell and all the cells below it into Sheet "Step1" Cell A1
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

You may try something like this...
Sub CoppyData()
Dim wsData As Worksheet, wsDest As Worksheet
Dim rng As Range
Application.ScreenUpdating = False

'Assuming the data is to be copied from ActiveSheet
Set wsData = ActiveSheet

'If data sheet is not the active sheet during code execution, set it as below
'Set wsData = Worksheets("Sheet1")   'Assuming Sheet1 is the name of Data Sheet.

Set wsDest = Worksheets("Step1")

'Clear the destination Sheet before pasting new data, if not required delete the below line
wsDest.Columns(1).ClearContents

With wsData.Range("A:A")
    Set rng = .Find(what:="OPEN END MORTGAGE DEED", lookat:=xlPart)
End With

If Not rng Is Nothing Then
    Range(rng, rng.End(xlDown)).Copy wsDest.Range("A1")
Else
    MsgBox "OPEN END MORTGAGE DEED was not found in column A on Data Sheet.", vbExclamation
End If
Application.ScreenUpdating = True
End Sub

Open in new window

Avatar of sandramac
sandramac

ASKER

Hi it is not finding the text, it is in there.
Please try this and see if this works for you.

Sub CoppyData()
Dim wsData As Worksheet, wsDest As Worksheet
Dim rng As Range
Application.ScreenUpdating = False

'Assuming the data is to be copied from ActiveSheet
Set wsData = ActiveSheet

'If data sheet is not the active sheet during code execution, set it as below
'Set wsData = Worksheets("Sheet1")   'Assuming Sheet1 is the name of Data Sheet.

Set wsDest = Worksheets("Step1")

'Clear the destination Sheet before pasting new data, if not required delete the below line
wsDest.Columns(1).ClearContents

With wsData.Range("A:A")
    Set rng = .Find(what:="OPEN END MORTGAGE DEED", LookIn:=xlValues, lookat:=xlPart)
End With

If Not rng Is Nothing Then
    Range(rng, rng.End(xlDown)).Copy wsDest.Range("A1")
Else
    MsgBox "OPEN END MORTGAGE DEED was not found in column A on Data Sheet.", vbExclamation
End If
Application.ScreenUpdating = True
End Sub

Open in new window

If it still doesn't work for you, please upload a sample workbook.
This question needs an answer!
Become an EE member today
7 DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform.
View membership options
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.