VBA Copy Paste Rows in a Range to Another Worksheet Based on Criteria

[Dk699]

Hi,

Can anyone please help me optimize the below code? I need it to run faster by selecting multiple rows at once on sheet "Pipe List" based on the criteria in C2 on sheet "pipeline details" and copying them all over together to sheet "Pipeline Details". Right now my code copies them individually and it is taking too long to run. I am open to completely rewriting this macro.

Sub BranchSort()


Application.ScreenUpdating = False
Call OptimizeCode_Begin

Range("A8:T8").Select
Selection.AutoFilter
Range("A9:T50000").Select
Selection.ClearContents


Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Dim Condition As Worksheet


Set Source = ActiveWorkbook.Worksheets("pipe list")
Set Target = ActiveWorkbook.Worksheets("Pipeline Details")
Set Condition = ActiveWorkbook.Worksheets("Pipeline Details")


j = 9 'This will start copying data to Target sheet at row 9
For Each d In Condition.Range("C2")
For Each c In Source.Range("c2:c50000")
If d = c Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Next d

Range("C2").Select
Call OptimizeCode_End
Application.ScreenUpdating = True
End Sub

 

[JLGWhiz]

I didn't test this because I don't have the two called macros, but you can try it and post back if necessary.

Sub BranchSort()
 Application.ScreenUpdating = False
 Call OptimizeCode_Begin
 ActiveSheet.Range("A8:T8").AutoFilter
 ActiveSheet.Range("A9:T50000").ClearContents
 'Dim c As Range
 'Dim j As Integer
 Dim Source As Worksheet
 'Dim Target As Worksheet
 Dim Condition As Worksheet
 Set Source = ActiveWorkbook.Worksheets("pipe list")
 Set Condition = ActiveWorkbook.Worksheets("Pipeline Details")
 Source.UsedRange.AutoFilter 3, Condition.Range("C2").Value
 Source.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Condition.Cells(9, 1)
 'j = 9 'This will start copying data to Target sheet at row 9
 'For Each d In Condition.Range("C2")
 'For Each c In Source.Range("c2:c50000")
 'If d = c Then
 'Source.Rows(c.Row).Copy Condition.Cells(j, 1)
 'j = j + 1
 'End If
 'Next c
 'Next d
 Source.AutoFilterMode = False
 Call OptimizeCode_End
 Application.ScreenUpdating = True
 End Sub

 

[Dk699]

Thank you! Works like a charm. The autofilter method is exactly what I needed.