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.
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
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:

ddasilva

New Member
Joined
Feb 27, 2019
Messages
8
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
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)
 

ddasilva

New Member
Joined
Feb 27, 2019
Messages
8
Hi,

I tried it but it gave me a 400 error or it said there was no data for my request.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
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)
 

Watch MrExcel Video

Forum statistics

Threads
1,109,543
Messages
5,529,456
Members
409,879
Latest member
Aussie_Excel_Wanna_Be
Top