Macro to copy and paste onto summary sheet based on criterion?

[tahir9]

'Select the sheets where Macro runs
 sheetlist = Array("1", "12", "13", "14", "Missplaced", "Plus1", "Plus2", "Plus3", "Plus4", "01", "02", "03", "04")
 For i = LBound(sheetlist) To UBound(sheetlist)
 Worksheets(sheetlist(i)).Activate
 
'Copy based on if criterion
 
Application.ScreenUpdating = False
 
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
 For x = LastRow To 1 Step -1
     If Cells(x, 7).Value > 7 Then
         Rows(x).copy
              Sheets("Summary").Select
                    [COLOR=#000000][FONT=Consolas]NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 
                  Cells(Nextrow, 1).Select
                     ActiveSheet.Paste
                         Sheets("1").Select
[/FONT][/COLOR]                                   End If
        Next
 
 Application.ScreenUpdating = True
 
  Next
 
Application.ScreenUpdating = True

 End Sub

I just have a couple of questions I want the macro to start from the last non blank cell. Currently I have another macro that hides all the blank cell using the autofilter function in vba. So even though my functions are in 3000 rows of data only a few of those rows are getting populated so I would like the macro to start at the last non blank row. And also I don't want the macro to go past the 5th row. Thats where it should stop. Atm it was running really slow and well I think its because its looking at all the rows where it should start with the first non blank cell that way it would be a lot quicker. Thanks for the help!

 

[JLGWhiz]

See if this modification works better.

'Select the sheets where Macro runs - You do not have to select to make code work.
 sheetlist = Array("1", "12", "13", "14", "Missplaced", "Plus1", "Plus2", "Plus3", "Plus4", "01", "02", "03", "04")
    For i = LBound(sheetlist) To UBound(sheetlist)
    LastRow = Sheets(sheetlist(i)).Cells(Rows.Count, "A").End(xlUp).Row
    'Copy based on if criterion
        For x = LastRow To 5 Step -1
            If Sheets(sheetlist(i)).Cells(x, 7).Value > 7 Then
                Rows(x).Copy Sheets("Summary").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next
    Next
Application.ScreenUpdating = True
End Sub

 

[tahir9]

It works fine but its really slow. Think its because I have a lot of formulas that produce blanks if there was a way to speed it that would be great. Thanks for your help it looks good.

 

[JLGWhiz]

It works fine but its really slow. Think its because I have a lot of formulas that produce blanks if there was a way to speed it that would be great. Thanks for your help it looks good.

I didn't test this, but see if it will run faster.

'Select the sheets where Macro runs - You do not have to select to make code work.
 sheetlist = Array("1", "12", "13", "14", "Missplaced", "Plus1", "Plus2", "Plus3", "Plus4", "01", "02", "03", "04")
    For i = LBound(sheetlist) To UBound(sheetlist)
    LastRow = Sheets(sheetlist(i)).Cells(Rows.Count, "A").End(xlUp).Row
    'Copy based on if criterion
        For x = LastRow To 5 Step -1
            With Sheets(sheetlist(i))
                .Range(.Cells(4, 1), .Cells(Rows.Count, 1).End(xlUp)).EntireRow.AutoFilter 7, ">7"
                .Range(.Cells(5, 1), .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                Sheets("Summary").Cells(Rows.Count, 1).End(xlUp)(2)
            End With
        Next
    Next
Application.ScreenUpdating = True
End Sub