< návrat zpět

MS Excel


Téma: Jméno listu podle buňky rss

Zaslal/a 20.10.2020 8:40

Ahoj.
Mám v sešitě kontingenční tabulku pokaždé s jiným počtem jmen a potřeboval bych ke každému jménu vytvořit list a podle buňky jej pojmenovat.

Snažím se pomocí tohoto, ale nedaří se.
Pomůže mi někdo, prosím?
Kód rovněž v příloze

Sub Prejmenuj_listy()

Dim rng As Range
Dim cell As Range

Set rng = ActiveSheet.Range("A5:A20")

For Each cell In rng
If cell.Value <> "" Then
Sheets.Add After:=ActiveSheet.Name = cell.Value
ElseIf Cells.Value = "" Then
End
Next cell

End Sub

Příloha: rar48474_test.rar (69kB, staženo 4x)
Zaslat odpověď >

#048476
avatar
A nestačí přesunout jméno do stránkového pole a pak v možnoste kont. tabulky vybrat "Zobrazit stránky filtru sestavy"?citovat
#048478
lugr
Tak?
Příloha: zip48478_test.zip (76kB, staženo 3x)
citovat
#048479
avatar
Hoj.
Nebo takto ?

Sub Prejmenuj_listy()

Dim rng As Range
Dim cell As Range

Set rng = ActiveSheet.Range("A5:A20")

For Each cell In rng
If cell <> "" Then
If cell <> "Celkový součet" Then
' Sheets.Add After:=ActiveSheet.Name = cell.Value
Sheets.Add(After:=Sheets(Sheets.Count)).Name = cell.Value
' ElseIf Cells.value = "" Then goto
End If
End If
Next cell

End Sub
citovat
#048480
avatar

lubo napsal/a:

A nestačí přesunout jméno do stránkového pole a pak v možnoste kont. tabulky vybrat "Zobrazit stránky filtru sestavy"?
Dobrý nápad. Ale zobrazí to všechny jména, i ta, která nejsou zrovna vybraná.

Do třetice všeho dobrého a zlého (když už jsem to vytvořil): Sub Prejmenuj_listy()
Dim pvtTable As PivotTable
Dim pvtitem As PivotItem
Dim novyList As Worksheet
Dim jmeno As String
Dim stejne As Boolean

stejne = False

Set pvtTable = Worksheets("Celkem").PivotTables("Kontingenční tabulka6")

For Each pvtitem In pvtTable.PivotFields("Zodpovídá").PivotItems 'Načítám všechny položky
On Error Resume Next
a = pvtitem.DataRange.Row 'Pokud pložka není zobrazena, nastane chyba
If Err.Number = 0 Then 'Pokud chyba nenastane
jmeno = pvtitem.Value 'načtu si jméno položky

For Each novyList In ActiveWorkbook.Sheets 'Kontrola, jestli neexistuje list se stejným názvem
If novyList.Name = jmeno Then
stejne = True
Exit For
End If
Next novyList

If Not stejne Then 'Pokud list ještě neexistuje, tak jej vytvoří
Sheets.Add.Name = jmeno
End If

End If
stejne = False

Next

On Error GoTo 0
End Sub
Příloha: zip48480_test1.zip (77kB, staženo 1x)
citovat
#048509
avatar
Jiří497, děkuji moc.
Sice řadí listy před list celkem ale to si upravím.
Musím říci že o proti prvnímu mému špatnému kódu je finální verze mnohem obsáhlejší a pro mě složitější. Ale jak jsem koukal tak obsahuje i kontrolní mechanizmy, tak za mě cajk.

Děkuji moc.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura III

Oblíbený formulář Faktura byl vylepšen a rozšířen. Formulář faktura III
Více se dočtete zde.

Aktivní diskuse

Počet jedinečných hodnot

MePExG • 3.12. 11:18

Počet jedinečných hodnot

elninoslov • 3.12. 8:38

Počet jedinečných hodnot

vikizaj • 2.12. 17:35

Počet jedinečných hodnot

lubo • 2.12. 17:34

rozdělení čísla do více buněk dle násobku

lubo • 2.12. 17:31

Automatické doplňování buněk

veny • 2.12. 17:31

Počet jedinečných hodnot

veny • 2.12. 17:10