VBA to find specific text and cut and past into new worksheet.
Closed
DonalK
-
May 16, 2017 at 08:57 AM
TrowaD
TrowaD
- Posts
- 2886
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- June 27, 2022
Related:
- Vba find cell with specific text
- Vba find and select cell with specific text - Best answers
- Excel vba select cell with specific text - Best answers
- Vba if cell contains specific text then ✓ - Forum - Excel
- Excel vba if cell contains specific text ✓ - Forum - Excel
- Vba highlight cell if cell contains specific text ✓ - Forum - Excel
- Vba fill blank cells with specific value ✓ - Forum - Programming
- If cell contains specific text then return value in another cell vba ✓ - Forum - Excel
2 replies
TrowaD
May 16, 2017 at 11:49 AM
- Posts
- 2886
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- June 27, 2022
May 16, 2017 at 11:49 AM
Hi DonalK,
I'm a little confused how many cells you want to cut.
First you say cut the cell with specific text and 2 or 3 cells below.
Then you say look at the cell below specific text and copy that cell (so the one below the specific text) and 2 or 3 cells below. That would mean; don't cut the specific text.
I went with the first one.
Give this code a try:
Best regards,
Trowa
I'm a little confused how many cells you want to cut.
First you say cut the cell with specific text and 2 or 3 cells below.
Then you say look at the cell below specific text and copy that cell (so the one below the specific text) and 2 or 3 cells below. That would mean; don't cut the specific text.
I went with the first one.
Give this code a try:
Sub RunMe() Dim mFind As Range Set mFind = Columns("A").Find("Technical date of entry") If mFind Is Nothing Then MsgBox "There is no cell found with the text 'Technical date of " _ & "entry' in column A of the active sheet." Exit Sub End If If IsDate(mFind.Offset(1, 0)) = True Then Range(mFind, Cells(mFind.Row + 2, "A")).Cut Sheets("Sheet1").Select Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select ActiveSheet.Paste ElseIf WorksheetFunction.IsNumber(mFind.Offset(1, 0)) = True Then Range(mFind, Cells(mFind.Row + 3, "A")).Cut Sheets("Sheet1").Select Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select ActiveSheet.Paste End If End Sub
Best regards,
Trowa
TrowaD
May 22, 2017 at 12:04 PM
- Posts
- 2886
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- June 27, 2022
May 22, 2017 at 12:04 PM
Hi DonalK,
Quite a few changes. For the code to work make sure your source sheet is called Sheet1 and your destination sheet is called sheet2 (or change those reference in the code).
Give this code a try:
Best regards,
Trowa
Quite a few changes. For the code to work make sure your source sheet is called Sheet1 and your destination sheet is called sheet2 (or change those reference in the code).
Give this code a try:
Sub RunMe() Dim mFind As Range Set mFind = Columns("A").Find("Technical entry date") If mFind Is Nothing Then MsgBox "There is no cell found with the text 'Technical entry date'" _ & " in column A of the active sheet." Exit Sub End If firstaddress = mFind.Address Do If IsDate(mFind.Offset(1, 0)) = True Then Range(mFind, Cells(mFind.Row + 2, "A")).EntireRow.Cut Sheets("Sheet2").Select Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select ActiveSheet.Paste ElseIf WorksheetFunction.IsNumber(mFind.Offset(1, 0)) = True Then Range(mFind, Cells(mFind.Row + 3, "A")).EntireRow.Cut Sheets("Sheet2").Select Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select ActiveSheet.Paste End If Sheets("Sheet1").Select Set mFind = Columns("A").FindNext(mFind) If mFind Is Nothing Then Exit Sub Loop While mFind.Address <> firstaddress End Sub
Best regards,
Trowa
May 22, 2017 at 08:59 AM
Thanks for coming back to me, I have a spread sheet that includes entries like the below, ideally I would like a code to find Technical entry date, if the line below Is a number it would cut row the tech entry row and the next 3 rows below and paste into the next sheet, it the line below the tech entry date is a date I need it to cut the tech entry date and the 2 lines below and paste into the next sheet, I also need this to loop through so that they are all removed from sheet 1 and pasted into sheet 2. Hope that makes sense.
Thank you,
Technical entry date
0011111 Ms Joe Blogs
11/2016 ( 01.11.2016 - 30.11.2016 )
IENDD
Technical entry date
12/2016 ( 01.12.2016 - 31.12.2016 )
IENDD