Copy and paste named range at end of loop causing massive slowdown over time

[Sccye]

Hi all,

So I'm currently running a fairly chunky macro that processes a load of data from different sources into, a series of nicely formatted tables on a single worksheet. Each 'table' represents one running of my loop. At the beginning and end of the loop, it pastes a named range before and after the 'table' - a range of colum headers on top and a series of pre-defined user inputs underneath, taken from a template worksheet.

The loop has to iterate through about 10,000 'tables'. After about 500 or so, the performance begins to tail off dramatically going from about 300 loops per minute to 60. I spent the best part of a day debugging and narrowed the bottleneck down to the lines of code that paste the header / footer ranges. On removing them, performance stays fast.

The macro is far too large to paste in here, but below is one section of the code where it pastes in the footer range. The line's immediate context is below the body of this post.

shtUnitTemplate.Range("unt_inputs").Copy shtComparison.Range("A" & lngDestWorkRow + 1)

I only copy and paste the range below the table (or cluster, in the code's parlance).

Does anybody have a clue why this would be slowing me down so radically and if so, is there anything I can do about it? I've read lots of different tips and tricks about how to optimise VBA copying and pasting, but none of them seem to have made a difference to date. Kind at my wits' end here, so any help would be massively appreciated.

Cheers,
Dan

'check if this is the last work in a cluster
        If shtWorks.Range("tbl_works").Cells(lngSrcWorkRow, intTblWorksColClusterID) <> shtWorks.Range("tbl_works").Cells(lngSrcWorkRow + 1, intTblWorksColClusterID) Then
        
            'end of cluster - copy and paste input rows and set next row
            shtUnitTemplate.Range("unt_inputs").Copy shtComparison.Range("A" & lngDestWorkRow + 1)
            Application.CutCopyMode = False
           
            lngDestWorkRow = lngDestWorkRow + shtUnitTemplate.Range("unt_inputs").Rows.Count
            
            'Moves source cluster ID to next one with present IPs, disallowing loop from executing
            If lngDestClstrID = lngSrcIPClstrID Then
                Do Until lngDestClstrID <> lngSrcIPClstrID
                    lngSrcIPClstrCtr = lngSrcIPClstrCtr + 1
                    lngSrcIPClstrID = Range("tbl_ips").Cells(lngSrcIPClstrCtr, intTblIPsColClusterID)
                Loop
                lngSrcIPClstrSubCtr = lngSrcIPClstrSubCtr + 1
            End If
                             
        End If