MS Excel

Zdravím, měl bych takový dotaz, všude jsem našel ruzné makra na mazání prázdných řádků a všeho možného, ale nikde jsem nenašel nějaké makro na mazání prázdných listů v sešitě. Nevíte jestli něco takového existuje ? Představoval bych si to tak, že by to v každém listu zkoumalo určitou oblast, tzn pokud by v listu bylo třeba od A1 - F30 pokud by v této oblasti byla hodnota buněk rovna 0. Tak by se ten list odstranil.

Díky za jekoliv náměty, nápady. Jak by to šlo.

Uzamčeno - nelze přidávat nové příspěvky.

Milan-D(3.10.2012 17:02)#009708

Jen tak narychlo naplacane, trochu se to komplikovalo tim, ze po vymazani listu se zmenil pocet listu v sesitu. Ale nejak jsem to zpytlikoval

Sub KillPrazdnyList()
Dim ws As Worksheet
Dim i As Long, j As Long, c As Integer

c = ThisWorkbook.Worksheets.Count

Application.DisplayAlerts = False

For i = 1 To c
Set ws = Worksheets(i)
ws.Activate
'Debug.Print ws.Name
For j = 1 To 30
If ws.Cells(65000, j).End(xlUp).Row > 1 Then Exit For
Next j

If j > 29 Then
On Error Resume Next
ws.Delete
If Err = 0 Then
c = c - 1
i = i - 1
If i = c Then Exit For
End If
On Error GoTo 0
End If
Next i

Application.DisplayAlerts = True
End Subcitovat

agnusxx(4.10.2012 21:09)#009729

To jo, ono to fakt funguje :D sice to hodi na konci hlašku out of range ale tu praci to uděla takže bomba, moc děkuji.citovat

marjankaj(5.10.2012 2:23)#009730

Asi najlepšie bude ísť na to odzadu

Sub KillPrazdnyList()
Dim ws As Worksheet
Dim i As Long, j As Long, c As Integer
c = ThisWorkbook.Worksheets.Count
Application.DisplayAlerts = False
On Error GoTo konec
For i = c To 1 Step -1
Set ws = Worksheets(i)
ws.Activate
'Debug.Print ws.Name
If ws.UsedRange.Cells.Count = 1 Then
If ws.UsedRange.Value = "" Then ws.Delete
End If
Next i
GoTo finito
konec: MsgBox " Tento list už nemôže byť zrušený"
finito: Application.DisplayAlerts = True
End Subcitovat

Mike23(3.7.2013 11:48)#014256

Ze školení, odkoukáno od školitele :-)

Sub DelBlanksheets() 'smazání prázdných listů

Dim SH As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each SH In Worksheets
If Application.WorksheetFunction.CountA(SH.Cells) = 0 Then SH.Delete

Next SH

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Subcitovat

Téma: Odstranění prazdného listu - makro

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje