Excel VBA - Formátovanie

Toto vlákno som nejako prehliadol, takže ak je to ešte aktuálne, tak daj vedieť a napíšem ti aj to druhé makro. Prvé makro by mohlo vyzerať takto:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aRange As Range
    Dim srcWorksheet As Worksheet
    Dim srcFirstCell As Range
    Dim srcLastCell As Range
    Dim dstWorksheet As Worksheet
    Dim dstCell As Range

    Set aRange = Intersect(Target, Range("D17,D20"))
    If Not aRange Is Nothing Then
        Set srcWorksheet = Worksheets("PrvaSK4")
        Set dstWorksheet = Worksheets("PTPRVA")
        dstWorksheet.Cells.Clear

        Set dstCell = dstWorksheet.Range("A1")
        Set srcFirstCell = srcWorksheet.Range("B3")
        For i = 1 To Range("D17")
            Set srcLastCell = srcFirstCell.Offset(Range("D20") - 1, 1)
            srcWorksheet.Range(srcFirstCell, srcLastCell).Copy dstCell

            Set dstCell = dstCell.Offset(0, 2)
            If i Mod 12 = 0 Then
                Set dstCell = dstCell.Offset(Range("D20") + 1, -dstCell.Column + 1)
                If dstCell.Row <= 44 And dstCell.Row + Range("D20") > 44 Then
                    Set dstCell = dstCell.Offset(44 - dstCell.Row + 1)
                End If
            End If

            Set srcFirstCell = srcFirstCell.Offset(0, 3)
        Next i
        dstWorksheet.Cells.ClearFormats
    End If
End Sub

Ďakujem za návrh riešenia.
Makro som vložil do listu 2 do Worksheet s Change ako je to v attachmente. Žial do listu "PTPRVA" sa nič neprenieslo. Neviem kde som urobil chybu, nedokážem to analyzovať.
Chcel by som zároveň poprosiť o menšiu zmenu zadania, ktorú som v čase jeho písania nedomyslel.
Ak by totiž došlo k zmene dát na liste "PrvaSK4" po zmene D17 alebo D20, potom by sa asi zmenené dáta neprekopírovali do "PTPRVA". Uvítal by som, keby sa podľa D17 a D20 tabuľka z listu "PrvaSK4" prekopírovala do listu "PTPRVA" pri aktivovaní listu "PTPRVA" (kliknutie na tento list)a nie pri zmene D17 alebo D20 (Možné je aj automatické spočítanie plných riadkov v rozsahu 3 až 24 a plných stĺpcov).
To isté by platilo pre druhé makro a dáta by sa z listov "PrvaSK4" a "Druha SK4", podľa zadania pre duhé makro, skopírovali pri aktivovaní listu "PT21" alebo "PT22".
Ďakujem

Aspoň sa to makro spustilo, t.j. vymazal sa celý obsah listu PTPRVA? Môžeš si do kódu umiestniť bod prerušenia pomocou klávesy F9 a potom makro krokovať pomocou klávesy F8. Tak uvidíš, že čo sa vlastne vykonáva.

Aby sa makro vykonalo pri aktivovaní listu a počet riadkov a stĺpcov sa určoval automaticky, tak by to mohlo vyzerať takto:

Private Sub Worksheet_Activate()
    Dim srcRange As Range
    Dim dstCell As Range

    Cells.Clear

    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")
    
    For i = 1 To nColumns / 3
        srcRange.Copy dstCell
        Set srcRange = srcRange.Offset(0, 3)

        Set dstCell = dstCell.Offset(0, 2)
        If i Mod 12 = 0 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
    Next i
    
    Cells.ClearFormats
End Sub

Ďakujem pekne,
pôvodné makro sa nespustilo vôbec a nešlo ho ani krokovať. Pravdepodobne to bude tým, že skúšal som to v Excel 2007 v emulácii pre 97-2003 (.xls). Neviem prečo? V E2007 to klapalo tak, ako popisujem ďalej.
Nové makro pri aktivovanom liste sa v E2007 rozbehlo, ale robí to psie kúsky. Totiž z "PrvaSK4" sa do "PTPRVA" prenášajú aj funkcie. Potrebujem a chcel by som poprosiť, aby sa do "PTPRVA" vkladali len hodnoty. Príkaz Cells.ClearFormats z makra vypustím. Chcem, aby zostal daný formát v "PTPRVA".
Vďaka, možno už bude aktuálne aj makro2

Môžeš riadok

srcRange.Copy dstCell

nahradiť za

srcRange.Copy
dstCell.PasteSpecial xlPasteValues

Potom príkaz Cells.ClearFormats nebude ani potrebný a namiesto prvého Cells.Clear bude stačiť volať Cells.ClearContents.

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...