Need to add a criteria to a loop formula[SOLVED]

[Cammandk]

This code currently runs fine. It goes through many sheets. Many of these sheets might not have any information to extract. In order to exclude them and speed process up I want the sheet to be skipped if DH7 in each sheet is not greater than 0.

Thanks DK.

Sub FloatExtract()
  Dim Sh As Worksheet
  Dim lr As Long

  Application.ScreenUpdating = False
  Sheet28.Range("D6:W300").ClearContents
  'Columns("G:H").EntireColumn.Hidden = False

  For Each Sh In Sheets(Array("Sch5", "Sch6", "Sch7", "Sch8", "Sch9", "Sch10", "Sch11", "Sch12", "Sch13", "Sch14", "Sch15", "Sch16", "Sch17", "Sch18", "Sch19", "Sch20", "Sch21", "Sch22", "Sch23", "Sch24", "Sch25", "Sch26", "Sch27", "Sch28", "Sch29", "Sch30", "Sch31", "Sch32", "Sch33", "Sch34", "Sch35", "Sch36", "Sch37", "Sch38"))

  Sh.Range("I1", Sh.Range("I" & Rows.Count).End(xlUp)).AutoFilter 1, "E"
  lr = Sh.Range("D" & Rows.Count).End(xlUp).Row
  If lr > 1 Then
  Sh.Range("D6", Sh.Range("V65536").End(xlUp)).Copy
  Sheet28.Range("D" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
  Application.CutCopyMode = False

  End If
  Sh.[i1].AutoFilter

  Next Sh

  Sheet28.Select

 

[Debraj]

Hi Dk..

Try this..

Sub FloatExtract()
  Dim Sh As Worksheet
  Dim lr As Long

  Application.ScreenUpdating = False
  Sheet28.Range("D6:W300").ClearContents
  'Columns("G:H").EntireColumn.Hidden = False

  For Each Sh In Sheets(Array("Sch5", "Sch6", "Sch7", "Sch8", "Sch9", "Sch10", "Sch11", "Sch12", "Sch13", "Sch14", "Sch15", "Sch16", "Sch17", "Sch18", "Sch19", "Sch20", "Sch21", "Sch22", "Sch23", "Sch24", "Sch25", "Sch26", "Sch27", "Sch28", "Sch29", "Sch30", "Sch31", "Sch32", "Sch33", "Sch34", "Sch35", "Sch36", "Sch37", "Sch38"))
If Sh.[DH7] > 0 Then
  Sh.Range("I1", Sh.Range("I" & Rows.Count).End(xlUp)).AutoFilter 1, "E"
  lr = Sh.Range("D" & Rows.Count).End(xlUp).Row
  If lr > 1 Then
  Sh.Range("D6", Sh.Range("V65536").End(xlUp)).Copy
  Sheet28.Range("D" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
  Application.CutCopyMode = False

  End If
  Sh.[i1].AutoFilter
End If
Next Sh

  Sheet28.Select

 

[Cammandk]

Thanks Debraj [SOLVED]