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