Copy multiple rows

christian2016

Board Regular
Joined
Oct 6, 2016
Messages
105
Im looping a range of cells in column A. If it meets a certain criteria need to copy that whole row.

Instead of individually copy and pasting the row everytime i loop when the if statement is true i want to keep adding that row to an array, collection or whatever is a better solution and once im out of the loop paste all the data in one hit.

Any help or assistance is greatly appreciated.

Thanks
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,876
Office Version
  1. 2013
Platform
  1. Windows
Try this:

If the value "Charlie" is found in column A that row will be copied to Sheet(2)

Code:
Sub Filter_Me_Please()
'Modified  3/23/2019  6:20:49 AM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Dim c As Long
Dim s As Variant
c = 1 ' Column Number Modify this to your need
s = "Charlie" 'Search Value Modify to your need
lastrow = Cells(Rows.Count, c).End(xlUp).Row
With ActiveSheet.Cells(1, c).Resize(lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(2).Rows(1)
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub
 

christian2016

Board Regular
Joined
Oct 6, 2016
Messages
105
Works well.

How do i modify it to paste as values.

i know its in this line but unsure on how to change it

Code:
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Worksheets("Sheet2").Rows(PasteRow)

Thanks
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,876
Office Version
  1. 2013
Platform
  1. Windows
Try this:
Code:
Sub Filter_Me_Please()
'Modified  3/23/2019  7:08:04 AM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Dim c As Long
Dim s As Variant
c = 1 ' Column Number Modify this to your need
s = "Charlie" 'Search Value Modify to your need
lastrow = Cells(Rows.Count, c).End(xlUp).Row
With ActiveSheet.Cells(1, c).Resize(lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        Sheets(2).Rows(1).PasteSpecial xlPasteValues
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,109,465
Messages
5,528,962
Members
409,848
Latest member
Blomsten
Top