Makro v MS Excel - problém se sloučenými buňkami
Napsal: 02 kvě 2017 00:13
Dobrý pozdní večer,
řeším následující problém:
V rámci 1 sešitu mám více listů, na všech listech se nachází naprosto stejná tabulka. Potřebuji makro, které po aktivaci aktualizuje tabulku na prvním listu s daty ze všech ostatních listů. Níže uvádím VB kód, který používám. Pokud ho použiji na sešit, ve kterém nepoužívám sloučené buňky je vše v pořádku. Pokud ho použiji v sešitu se sloučenými buňkami (v záhlaví tabulky), makro nefunguje. Problém je zřejmě s identifikací řádků resp. sloupců, které mají sloučené buňky. Přijde mi, že VB pracuje s "viditelnými řádky" (2 sloučené počítá jako jeden) a ne s excelem označenými řádky (2 sloučené jako 2).
Prosím o radu, jak makro upravit popřípadě jaký jiný způsob použít.
Předem mockrát díky za všechny rady
Kód pro tabulku s 54 sloupci:
řeším následující problém:
V rámci 1 sešitu mám více listů, na všech listech se nachází naprosto stejná tabulka. Potřebuji makro, které po aktivaci aktualizuje tabulku na prvním listu s daty ze všech ostatních listů. Níže uvádím VB kód, který používám. Pokud ho použiji na sešit, ve kterém nepoužívám sloučené buňky je vše v pořádku. Pokud ho použiji v sešitu se sloučenými buňkami (v záhlaví tabulky), makro nefunguje. Problém je zřejmě s identifikací řádků resp. sloupců, které mají sloučené buňky. Přijde mi, že VB pracuje s "viditelnými řádky" (2 sloučené počítá jako jeden) a ne s excelem označenými řádky (2 sloučené jako 2).
Prosím o radu, jak makro upravit popřípadě jaký jiný způsob použít.
Předem mockrát díky za všechny rady
Kód pro tabulku s 54 sloupci:
Kód: Vybrat vše
Sub SpojListy()
Dim ws As Worksheet, rs As Long, rd As Long
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With ThisWorkbook
With .Worksheets("List1")
rs = .Cells(Rows.Count, 4).End(xlUp).Row - 1
If rs > 0 Then .Cells(4, 1).Resize(rs, 54).ClearContents
End With
For Each ws In .Worksheets
rs = .Worksheets("List1").Cells(Rows.Count, 4).End(xlUp).Row
With ws
If .Name <> "List1" Then
rd = .Cells(Rows.Count, 4).End(xlUp).Row - 1
If rd > 0 Then ThisWorkbook.Worksheets("List1").Cells(rs + 1, 1).Resize(rd, 54).Value = .Cells(4, 1).Resize(rd, 54).Value
End If
End With
Next ws
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub