Can't loop through multiple sheets

[the whistler]

Hey,


I am analysing data. Taking 3 columns, and putting them into a new workbook. Saving, then closing. the code works fine, but I can't get it to loop through worksheets.
I've tried several of the suggested methods and none of them have worked on my system. I tested them using: "range("A1").value = "banana"", to print in each sheet but the code will only run once and stop.
I can get
Worksheets(ActiveSheet.Index + 1).Select
to work but then the code doesn't loop.




What I have from a macro recording is:
Sub workingnoloop()

Dim Path As String
Dim filename As String
Path = "C:\Users\Whistler\Desktop"
filename = Range("A2")
'
Columns("H:I").Select
Application.CutCopyMode = False
Selection.Copy
Range("L1").Select
ActiveSheet.Paste
Range("K1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Time"
Range("K2").Select
ActiveCell.FormulaR1C1 = "0"
Range("K3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+RC[-6]-R[-1]C[-6]"
Range("K3").Select
Selection.AutoFill Destination:=Range("K3:K2997")
Range("K3:K2997").Select
Range("N1").Select
ActiveCell.FormulaR1C1 = "%missing"
Range("N2").Select
ActiveCell.FormulaR1C1 = _
"=COUNTBLANK(RC[-2]:R[2999]C[-2])/COUNT(RC[-3]:R[2999]C[-3])*100"
Columns("K:N").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.SaveAs filename:=Path & filename & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close


Each workbook has between 27-31 sheets in them to loop through. Any help here would be great.




The data is compiled with a PIVOT table, and I need one colum to be sorted from smallest to largest, and have the numbers in other colums follow their trend. I couldn't seem to code that sort function in though, since it's lock to the pivot. Does anyone know how to include that in the above code too?

 

[mikerickson]

All of your references are un-qualified. That means that you aren't specifying which sheet the refer to.

First you should go through the code and change all the Range("A1") type references to ActiveSheet.Range("A1")

The macro should work exactly as it does now, but the references are qualified.

Then, add a Worksheet variable to your code

Sub workingnoloop()
    Dim ws As Worksheet

    ' your code
End Sub

Then use Find/Replace to change all the ActiveSheet.Range("A1") to ws.Range("A1")
Then set ws to the active sheet

Sub workingnoloop()
    Dim ws As Worksheet

    Set ws = ActiveSheet

    ' your code
End Sub

Again, this should act just as the OP code. But it will check that the changes were done properly.

Then you can loop the ws variable through all the worksheets in the Workbook

Sub workingnoloop()
    Dim ws As Worksheet

    Set ws = ActiveSheet ' remove <<<<

    For each ws In ActiveWorkbook.Worksheet
        ' your code
    Next ws
End Sub

 

[mikerickson]

cross post Can't get code to loop through worksheets

 

[the whistler]

I can get it to loop with simple code. however, in the big one it breaks at the first ws.range line after the first loop and gives error "run time error '1004': select method of range class failed"

current code:
Option Explicit






Sub workingtestloop()
'loop start
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
'/loop starts
'code
Dim Path As String
Dim filename As String
Path = "C:\Users\Whistler\Desktop"
filename = ws.Range("A2")


Columns("H:I").Select
Application.CutCopyMode = False
Selection.Copy
ws.Range("L1").Select
ActiveSheet.Paste
ws.Range("K1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Time"
ws.Range("K2").Select
ActiveCell.FormulaR1C1 = "0"
ws.Range("K3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+RC[-6]-R[-1]C[-6]"
ws.Range("K3").Select
Selection.AutoFill Destination:=Range("K3:K2997")
ws.Range("K3:K2997").Select
ws.Range("N1").Select
ActiveCell.FormulaR1C1 = "%missing"
ws.Range("N2").Select
ActiveCell.FormulaR1C1 = _
"=COUNTBLANK(RC[-2]:R[2999]C[-2])/COUNT(RC[-3]:R[2999]C[-3])*100"
Columns("K:N").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.SaveAs filename:=Path & filename & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
'/code
'loop end
Next ws
'/loop end


End Sub

 

[mikerickson]

I didn't read your code carefully and missed that you were Selecting. You'll have to put

ws.Activate

after the start of the loop.

 

[the whistler]

It worked! You've saved me hours. You're my Excel MVP! Thank you!

 

[Michael M]

@ the whistler
It might pay to read this before you post next time

Excelguru Help Site - A message to forum cross posters