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

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