MS Excel

Téma: Seskupení ve všech listech

Zaslal/a Raders486 22.10.2020 9:52

Ahoj.
Pro seskupení ve všech listech mino listy Celkem a Data bych chtěl použít toto, ale někdy doběhne a někdy se sekne. Problém bude určitě někde kolem ws.select.

Poradí někdo, děkuji?

Dim ws As Worksheet
Application.ScreenUpdating = True
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Celkem" And ws.Name <> "Data" Then

ws.Select

Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

Columns("D:D").EntireColumn.NumberFormat = _
"_-* #,##0 _K_č_-;-* #,##0 _K_č_-;_-* ""-"" _K_č_-;_-@_-"

End If

Next ws

Zaslat odpověď >

Raders486(22.10.2020 10:21)#048553

Sice trochu kostrbatě, ale mám to

Sub seskupit()

Application.ScreenUpdating = True
Application.DisplayAlerts = False

For Each ws In ActiveWorkbook.Worksheets

If ws.Name = "Celkem" Or ws.Name = "Data" Then

Else
ws.Select

ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add2 Key:=Range("B2:B500" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ws.Sort.SortFields.Add2 Key:=Range("C2:C500" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ws.Sort.SortFields.Add2 Key:=Range("D2:D500" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ws.Select
With ws.Sort
.SetRange Range("A1:AR500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

ws.Select
Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

Columns("D:D").EntireColumn.NumberFormat = _
"_-* #,##0 _K_č_-;-* #,##0 _K_č_-;_-* ""-"" _K_č_-;_-@_-"

End If

Next ws

Application.DisplayAlerts = True
Application.ScreenUpdating = False

End Sub
citovat

Téma: Seskupení ve všech listech

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje