Nisam najbolje shvatio post ali ukoliko mislis da naredbu koju si kreirao da radi na vise listova pokusaj sa dole navedenim programskim kodom. Izmeni i adresu prema folderu u kom se nalaze tvoji dokumenti

Sub listovi()
Dim FSO As Object, Folder As Object, file As Object
Dim dokument As Workbook
Dim list As Worksheet
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("C:\Proba")
For Each file In Folder.Files
If LCase(Right(file.Name, 4)) = ".xlsx" Then
Set dokument = Workbooks.Open("C:\Proba\" & file.Name)
For Each list In dokument.Sheets
' programski kod za odredjenu akciju
Next list
dokument.Close True
End If
Next file
MsgBox "Gotovo"
End Sub

Da pojednostavim. Kako da skratim makronaredbu da ne pišem 30 istih, ovo mi je primjer za prva dva lista. Pitanje je kako bi glasila naredba za 30 listova? I da imam istu oznaku za sve listove.(Tipkovni prečac) npr. Ctrl+n za sve listove

Sub sortiranje1()
'
' sortiranje1 Makronaredba
'
' Tipkovni prečac: Ctrl+n
'
Range("B7:H30").Select
ActiveWorkbook.Worksheets("1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("1").Sort.SortFields.Add Key:=Range("F7:F30"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("1").Sort
.SetRange Range("B7:H30")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("I7").Select
End Sub
Sub sortiranje2()
'
' sortiranje Makronaredba
'
' Tipkovni prečac: Ctrl+n
'
Range("B7:H30").Select
ActiveWorkbook.Worksheets("2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("2").Sort.SortFields.Add Key:=Range("F7:F30"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("2").Sort
.SetRange Range("B7:H30")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("I7").Select
End Sub

<sub>[Ovu poruku je menjao arthichoka dana 23.08.2012. u 23:46 GMT+1]

[Ovu poruku je menjao arthichoka dana 23.08.2012. u 23:47 GMT+1]</sub>

Ukoliko želiš da program radi samo na jednom listu tada je potrebno da na početku programskog koda ubaciš sledeće redove:

Dim poruka
Dim list as Integer
poruka = "Unesite broj lista:"
list = InputBox (poruka)
Worksheets(list).Activate


Ukoiko želiš da program radi na svim listovima onda upotrebi kod kojeg sam napisao u prethodnom postu s napomenom da na početku tvog koda ubaciš red:

Worksheets(list).Activate

Riješio problem: Worksheets("1") zamijenio sa ActiveSheet i makro naredba radi samo na aktivnom listu.