Excel VBA - Formátovanie

Druhé makro pre list PT21, ktoré počíta s tým, že počet stĺpcov v tabuľkách na listoch PrvaSK4 a DruhaSK4 je rovnaký (počet riadkov nemusí byť rovnaký), môže vyzerať takto:

Private Sub Worksheet_Activate()
    Dim srcRange As Range
    Dim dstCell As Range
    Dim aRange As Range
    Dim aCell1 As Range
    Dim aCell2 As Range

    Cells.ClearContents

    Set srcRange = Worksheets("PrvaSK4").Range("B3")
    nRows = srcRange.End(xlDown).Row - srcRange.Row + 1
    nColumns = srcRange.End(xlToRight).Column - srcRange.Column + 1

    Set srcRange = srcRange.Resize(nRows, 2)
    Set dstCell = Range("A1")

    Set aCell1 = Worksheets("PrvaSK4").Range("B3").End(xlDown).Offset(1, 1)
    Set aCell2 = Worksheets("DruhaSK4").Range("B3").End(xlDown).Offset(1, 1)

    For i = 1 To nColumns / 3
        If aCell1 >= aCell2 Then
            srcRange.Copy
            dstCell.PasteSpecial xlPasteValues

            Set dstCell = dstCell.Offset(0, 2)
            If dstCell.Column / 24 > 1 Then
                Set dstCell = dstCell.Offset(srcRange.Rows.Count + 1).End(xlToLeft)
                If dstCell.Row <= 44 And dstCell.Row + srcRange.Rows.Count > 44 Then
                    Set dstCell = dstCell.Offset(44 - dstCell.Row + 1)
                End If
            End If
        End If

        Set srcRange = srcRange.Offset(0, 3)
        Set aCell1 = aCell1.Offset(0, 3)
        Set aCell2 = aCell2.Offset(0, 3)
    Next i
End Sub

Pre list PT2 treba v makre nahradiť riadok

Set srcRange = Worksheets("PrvaSK4").Range("B3")

za riadok

Set srcRange = Worksheets("DruhaSK4").Range("B3")

a obidva riadky

If aCell1 >= aCell2 Then

za riadky

If aCell1 < aCell2 Then

Moje veľké Vďaka,
teraz to už pracuje skoro tak, ako som si to predstavoval. Chcelo by to ešte podľa zadania úpravu a to:
ďalších max. 12 dvoj-stĺpcov sa kopíruje pod prázdny riadok pod predchádzajúce skopírované dvoj-stĺpce.
Teraz ďalších max. 12 dvoj-stĺpcov sa kopíruje od riadku 45 a ďalších
12 dvoj-stĺpcov od riadku 68, 91 a dva dvoj-stĺpce od riadku 114 . Kopírovanie nekončí posledným plným stĺpcom, ale makro kopíruje aj prázdne stĺpce do počtu 50 tich dvojstĺpcov.
Kopírovanie na riadku 45 má začínať vtedy, ak by predchádzajúce 12 dvoj-stĺpce mali byť riadkom 44 rozdelené, alebo ak dvojstĺpce končia na riadku 44. Riadkom 45 začína nová stránka.
Rovnako pracuje aj makro 2, ináč perfektne.

Trochu rušivo pôsobí, že pri každom opätovnom klepnutí na listy PTPRVA, PT21 alebo PT22 aj keď sa dáta už nemenia, dochádza k novému prepočítaniu.Prvotné zadanie dát sa robí na liste 1 a zmeny sa prenášajú na listy PrvaSK4 a DruháSK4. Ak by na liste 1 nedošlo k žiadnej zmene potom by bolo žiadúce, aby sa už listy PTPRVA, PT21 a PT22 pri ich opätovnom preklikávaní nemenili. Táto skutočnosť vyplynula až teraz keď som to uvidel. Pokiaľ by to bolo možné realizovať a našli by ste si voľný čas bol by som Vám veľmi vďačný.

K tomu rušivému prepočítaniu: Najjednoduchšie by asi bolo pridať tlačidlá, ktorými by používateľ spúšťal prepočet explicitne a automatické prepočítavanie by tam nebolo.

Ak to ale chceš prepočítavať automaticky po zmene na liste 1, tak do neho môžeš pridať takéto makro:

Public UpdatedAt

Private Sub Worksheet_Change(ByVal Target As Range)
    UpdatedAt = Now
End Sub

Potom by malo stačiť už len upraviť začiatok makier na ostatných listoch na niečo takéto:

Dim UpdatedAt

Private Sub Worksheet_Activate()
    If UpdatedAt = Worksheets("List1").UpdatedAt Then Exit Sub
    UpdatedAt = Worksheets("List1").UpdatedAt
    ...

Ešte by som doplnil, že sa kopírujú aj prázdne riadky. Tabulky PrvaSK4 a DruhaSK4 majú v každej bunke B3:EU24 funkciu. Za plné riadky a stĺpce považovať len tie, ktoré obsahujú hodnoty, nie funkcie.

Po dlhšom čase sa mi podarilo zistiť, prečo makrá nechodia tak, ako by mali. Problém je v tom, že prvý a každý ďalší tretí stĺpec na liste Prva SK4 má v každej bunke generované fciou =IF(ISERROR(VLOOKUP(List3!B3;List1!$A$3:$B$24;2;0) );" "; VLOOKUP(List3!B3;List1!$A$3:$B$24;2;0)). Táto fcia mi síce vizuálne v tabuľke vytvára prázdne riadky a stĺpce, ale v skutočnosti sú tam medzery (" ")a tieto sú potom pri počítaní plných riadkov a stĺpcov započítané. Preto sa potom kopíruje plná tabulka.Túto fciu k vôli rýchlosti nechcem nahradiť makrom.
Počet skutočných riadkov už mám v D20 na liste2 a počet trojstĺpcov je v D17 na liste2. Nešlo by upraviť makrá tak, aby sa automaticky nepočítali riadky a stĺpce tabuľky, ale použili sa hodnoty D17 a D20?
Ďakujem

Vo všetkých makrách nahraď priradenie do premenných nRows a nColumns za:

nRows = Worksheets("List2").Range("D20")
nColumns = Worksheets("List2").Range("D17")

Ďalej vo všetkých cykloch odstráň delenie číslom 3, čiže tam bude len toto:

For i = 1 To nColumns

A nakoniec v makrách pre PT21 a PT22 nahraď priradenie do premenných aCell1 a aCell2 za:

Set aCell1 = Worksheets("PrvaSK4").Range("B3").Offset(nRows, 1)
Set aCell2 = Worksheets("DruhaSK4").Range("B3").Offset(nRows, 1)

Vďaka za odpoveď,
u makra1 som narazil na nepresnosť. Ak tabuľka Prva SK4 má nRows=14, nColumns=48, potom do PTPRVA sa kopíruje nasledovne: Prvé a druhé 12 dvojstĺpce sa kopírujú OK (do A1:X14 a A16:X29). Tretie 12 dvojstĺpce by sa mali skopírovať do oblasti A31:X44 avšak tie sa už kopírujú do A45:X58 (nie sú ešte rozdelené riadkom 44). Štvrté 12 dvojstĺpce by sa potom mali skopírovať do A45:X58 avšak sa kopírujú do A60:X73.
To isté platí u makra2, ak je počet v PT21 alebo PT22 väčší, ako 24 dvojstĺpcov. Toto neviem odstrániť.
Premenné aCell1 a aCell2 musia mať v Offset (22,1) - hodnoty sa musia porovnávať vždy na riadku 25.

Chyba je v podmienke, ktorá kontroluje, či oblasť prechádza riadkom 44. Správne to má byť takto:

If dstCell.Row <= 44 And dstCell.Row + srcRange.Rows.Count - 1 > 44 Then

Super, chyba sa odstránila, ale ešte je tam menšia maličkosť. Posledných 12 dvojstĺpcov sa nezačína na riadku 45 (A45:X58), ale na riadku 46 (A46:X59). Na Riadku 45 by mala byť nová strana.

Tak to by tá podmienka mohla nakoniec vyzerať ešte trochu inak:

If dstCell.Row <= 46 And dstCell.Row + srcRange.Rows.Count - 1 > 44 Then

Teraz kopírovanie funguje presne, pokiaľ pri testovaní nenarazím na nejaký skrytý problém, tak to považujem za ukončené. Zatiaľ som nenašiel, ako to označiť za ukončené.
Mám ešte jednu špecialitku, ale tú v novom vlákne
Veľmi pekne ďakujem. Ste maestro. " Kdo umí ten umí, kdo neumí ten ..."

Nahoře pod dotazem je zelená fajfka...