Excel VBA Macro starts fast then slows-CodePudding

I am parsing data from one worksheet and creating two columns in another worksheet then saving that new worksheet to a tab delineated file. It will do about 30-35 in a couple seconds then immediately slows to about 1 a minute. Any ideas on why it is slowing or how to diagnose the problem?

Sub DataMove()
    Dim wksName As String
    Dim FolderPath As String
    Dim OrgWks As String
    Dim wkbName As String
    Dim wb As Workbook
    Dim RowNum As Long
    Dim ColNum As Long
    Dim NameRow As Long
    Dim DestRow As Long
    Dim NumRows As Long
    Dim NumRows2 As Long
    Dim NumCols As Long
       
    DestRow = 1
    ColNum = 8
    RowNum = 4
    
    wkbName = Application.ActiveWorkbook.Name
    FolderPath = Application.ActiveWorkbook.Path
    OrgWks = ActiveSheet.Name
    NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
    NumCols = Range("G4", Range("G4").End(xlToRight)).Columns.Count
    NumCols = NumCols   6
    While RowNum <= NumRows
        Workbooks(wkbName).Activate
        NameRow = RowNum - 2
        wksName = Worksheets(OrgWks).Cells(NameRow, 29).Value
        Sheets.Add Type:=xlWorksheet
        ActiveSheet.Name = wksName
        While ColNum < NumCols
            With Worksheets(wksName)
                .Cells(DestRow, 1).Value = Worksheets(OrgWks).Cells(RowNum, ColNum)
                .Cells(DestRow, 2).Value = Worksheets(OrgWks).Cells(RowNum, ColNum - 1)
                ColNum = ColNum   3
                DestRow = DestRow   1
            End With
        Wend
        RowNum = RowNum   3
        ColNum = 8
        DestRow = 1
        NumRows2 = Range("A1", Range("A1").End(xlDown)).Rows.Count
        Cells(1, 1).Select
        Selection.Resize(NumRows2, 2).Copy
        Set wb = Workbooks.Add
        Cells(1, 1).PasteSpecial Paste:=xlPasteValues
        wb.SaveAs Filename:=FolderPath & "\" & wksName, FileFormat:=xlCSVUTF8, CreateBackup:=False
        Workbooks(wksName).Close SaveChanges:=False
    Wend
End Sub

CodePudding user response：

There are several lines that can be cleaned up, and getting rid of Activate and Select can shave off a few tenths of a second. The only thing I see that would really slow it down by 30 seconds is Selection.Resize(NumRows2, 2).Copy. Moving a few hundred thousand cells into the windows clipboard can sometimes be very slow. My advice is dodge the clipboard and keep the values within Excel. Dont use Copy and just assign the values directly.

Set wb = Workbooks.Add
wb.Worksheets(1).Cells(1, 1).Resize(NumRows2, 2).Value = Workbooks(wkbName).Worksheets(wksName).Cells(1, 1).Resize(NumRows2, 2).Value