If text within cell, copy cell

ddasilva

New Member
Joined
Feb 27, 2019
Messages
8
Hi All,

Out of maybe 1000 rows, I only want the ones with a specific text string in column D to be copied over to another sheet within the workbook.

For example, if D27 says "Computer Checks", I want to copy the data from that row over but don't want to have 25 blank rows above it that don't meet the criteria.

What would be the most efficient way to do this?

Thanks in advance.
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Try with this macro. Change data in red with your data

Code:
Sub Macro2()
    Application.ScreenUpdating = False
    ActiveSheet.Range("A1").CurrentRegion.AutoFilter Field:=4, _
        Criteria1:="[COLOR=#ff0000]Computer Checks[/COLOR]"
    u = Range("D" & Rows.Count).End(xlUp).Row
    If u > 1 Then
        ActiveSheet.Range("A1").CurrentRegion.Copy
        Sheets("[COLOR=#ff0000]sheet2[/COLOR]").Range("A1").PasteSpecial Paste:=xlPasteValues
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        MsgBox "Copied Range "
    Else
        MsgBox "There are no data with this criteria"
    End If
End Sub
 
Last edited:
Upvote 0
Hi there,

I kept getting a 400 error with that macro but was able to do something similar so thank you for the suggestion. However, I am getting incorrect output. Would you be able to tell me what's wrong? From what I can see, it should be a 5 column output but I get 9 columns.

Code:
Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1


For Each cell In Worksheets("GL").Range("D1:D2000")
    If cell.Value = "Computer Checks" Then
        If MyCount = 1 Then Set NewRange = cell.Offset(0, 1)
        Set NewRange = Application.Union(NewRange, cell.Offset(0, 1))
        MyCount = MyCount + 1
    End If
Next cell


'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("B3")


'--> Remove Duplicates
ActiveSheet.Range("B3:B2000").RemoveDuplicates


For Each cell In Worksheets("GL").Range("D1:D2000")
    If cell.Value = "Computer Checks" Then
        If MyCount = 1 Then Set NewRange = cell.Offset(0, -2)
        Set NewRange = Application.Union(NewRange, cell.Offset(0, -2))
        MyCount = MyCount + 1
    End If
Next cell


'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("C3")


'--> Remove Duplicates
ActiveSheet.Range("C3:C2000").RemoveDuplicates


For Each cell In Worksheets("GL").Range("D1:D2000")
    If cell.Value = "Computer Checks" Then
        If MyCount = 1 Then Set NewRange = cell.Offset(0, 2)
        Set NewRange = Application.Union(NewRange, cell.Offset(0, 2))
        MyCount = MyCount + 1
    End If
Next cell


'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("D3")


'--> Remove Duplicates
ActiveSheet.Range("D3:D2000").RemoveDuplicates


For Each cell In Worksheets("GL").Range("D1:D2000")
    If cell.Value = "Computer Checks" Then
        If MyCount = 1 Then Set NewRange = cell.Offset(0, -3)
        Set NewRange = Application.Union(NewRange, cell.Offset(0, -3))
        MyCount = MyCount + 1
    End If
Next cell


'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("E3")


'--> Remove Duplicates
ActiveSheet.Range("E3:E2000").RemoveDuplicates


For Each cell In Worksheets("GL").Range("D1:D2000")
    If cell.Value = "Computer Checks" Then
        If MyCount = 1 Then Set NewRange = cell.Offset(0, 4)
        Set NewRange = Application.Union(NewRange, cell.Offset(0, 4))
        MyCount = MyCount + 1
    End If
Next cell


'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("F3")


'--> Remove Duplicates
ActiveSheet.Range("F3:2000").RemoveDuplicates


End Sub
 
Upvote 0
For example, if D27 says "Computer Checks", I want to copy the data from that row over but don't want to have 25 blank rows above it that don't meet the criteria.

Did you test the macro that I put in post 2?



If it is not what you need, you could give examples, several examples, of what you have and what you expect of result.
Or
You could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
(Do not forget to explain what you have and what you expect from the result)
 
Upvote 0
Hi:
Did you modify the macro?
You can put a data sample or

You could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
(Do not forget to explain what you have and what you expect from the result)
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,316
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top