Run code for everysheet that is ont the workbook.

[agas]

How can i make this code run every sheet that is on the workbook ?

Sub AAP()
 
    ChDir "C:\Documents and Settings\aoz\Desktop\cap rep\1\"
    Workbooks.Open Filename:= _
    "C:\Documents and Settings\aoz\Desktop\cap rep\1\TK_LO_CAP_REP.xls"
        
    With ActiveSheet
    .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
        "AYT", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "ETF", "FAA", "GBB", "IMT", "TIE", "TIP", _
        "YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues
    .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .Range("$A$3:$AG$10000").AutoFilter Field:=1
    End With
    
      ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\aoz\Desktop\cap rep\1\" & "AAP_TK_LO_CAP_REP.xls (" & Format(Date, "dd-mm-yyyy") & ").xls" _
  , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
  
End Sub

 

[truskawa]

Hi, I just added a loop to loop through all worksheets in workbook.
Try this:

Sub AAP()

Dim ws As Worksheet

ChDir "C:\Documents and Settings\aoz\Desktop\cap rep\1\"
Workbooks.Open Filename:= _
"C:\Documents and Settings\aoz\Desktop\cap rep\1\TK_LO_CAP_REP.xls"


For Each ws In ActiveWorkbook.Worksheets
With ws
.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
"AYT", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "ETF", "FAA", "GBB", "IMT", "TIE", "TIP", _
"YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues
.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Range("$A$3:$AG$10000").AutoFilter Field:=1
End With
Next ws

ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\aoz\Desktop\cap rep\1\" & "AAP_TK_LO_CAP_REP.xls (" & Format(Date, "dd-mm-yyyy") & ").xls" _
, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

End Sub

 

[agas]

Hello and thanks a lot for the answer.

But i get and error like this "Methog 'Range' of object'_Worksheet' failed.

 

[agas]

When i change the code to this, this time it is doing the range but not doing the delete.

AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
this piece suppose to select the remaning cells and delete them. But it is not working.
Is there an other way to select the remaning cells under the filter row and delete them ?

Sub ziki()
Dim ws As Worksheet
ChDir "C:\Documents and Settings\aozben\Desktop\cap rep\1\"
Workbooks.Open Filename:= _
"C:\Documents and Settings\aozben\Desktop\cap rep\1\TK_LO_CAP_REP.xls"

For Each ws In ActiveWorkbook.Worksheets
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _
"AYT", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "ETF", "FAA", "GBB", "IMT", "TIE", "TIP", _
"YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues
AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Range("$A$3:$AG$10000").AutoFilter Field:=1
Next ws
 
ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\aozben\Desktop\cap rep\1\" & "AAP_TK_LO_CAP_REP.xls (" & Format(Date, "dd-mm-yyyy") & ").xls" _
, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

 

[truskawa]

Hi, try this. I added select for worksheet. It should help

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> AAP()<br><br><SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet<br><br>ChDir "C:\Documents and Settings\aoz\Desktop\cap rep\1\"<br>Workbooks.Open Filename:= _<br>    "C:\Documents and Settings\aoz\Desktop\cap rep\1\TK_LO_CAP_REP.xls"<br><br><br><SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> ws <SPAN style="color:#00007F">In</SPAN> ActiveWorkbook.Worksheets<br>    <SPAN style="color:#00007F">With</SPAN> ws<br>        .Select<br>        .Range(Selection, ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=1, Criteria1:=Array( _<br>            "AYT", "DGT", "DHA", "DHQ", "DLB", "DLD", "DLI", "ETF", "FAA", "GBB", "IMT", "TIE", "TIP", _<br>            "YSE", "YSM", "YSP", "MAA", "YSA"), Operator:=xlFilterValues<br>        .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete<br>        .Range("$A$3:$AG$10000").AutoFilter Field:=1<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">Next</SPAN> ws<br><br>ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\aoz\Desktop\cap rep\1\" & "AAP_TK_LO_CAP_REP.xls (" & Format(Date, "dd-mm-yyyy") & ").xls" _<br>    , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False<br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[agas]

Yay, it is working thank you very much.

 

[Weaver]

Using arrays for criteria, is that an XL2007 thing?

I tried this in 2003 ages ago (we're a bit behind the curve @ work) and had no luck with it, wound up using advanced filter.

W

 

[agas]

Yea i am doing this on 2007. Never tried on 2003 though.

I hope 2010 and 2007 macros are compatible. If not i am doomed. Because we are gonna switch to 2010 in a few months.