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
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Jméno listu podle buňky
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
MS Excel
Téma: Jméno listu podle buňky 
Zaslal/a Raders486 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: 
48474_test.rar (69kB, staženo 18x)
48474_test.rar (69kB, staženo 18x)Tak?
Příloha: 48478_test.zip (76kB, staženo 19x)
citovat48478_test.zip (76kB, staženo 19x)(20.10.2020 12:58)#048479
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 Subcitovat
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 Subcitovat
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"?
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: 48480_test1.zip (77kB, staženo 16x)
citovat48480_test1.zip (77kB, staženo 16x)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
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)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články