Can you find what's causing my Excel VB script to slow down?

Question

First a little background: I had a need for a script to take n CSV files in a directory I selected and copy and paste their individual data into a "master" Excel Workbook file with n tabs. I also need the script to automatically name the tabs something useful.

I Frankenstein'd a script together using a combination of macro recording, pieces I found on here, and good ol' fashioned Googling. It runs without too many errors; however, towards the end of the process (if there's 10+ CSV files) it slows down quite a bit.

I've tried a few different versions of making sure the clipboard is cleared, the current file being copied is closed, suppressing the opening and closing animation of the master file, etc. The only thing that was successful up to this point was (what I think works) clearing the clipboard.

I will admit this is my first venture into Visual Basic and I'm not a professional programmer so the code probably doesn't handle memory properly.

My question is: Can you spot a section(s) / operation(s) that is / are slowing the code down towards the end? Or at least provide a viable explanation as to why it would be happening? In general, my laptop is no slouch. It's an HP EliteBook with i5 processor and 8GB of RAM so I can't imagine it's a resource problem.

I've sanitized the code and any references to personal directories and posted it below.

Thank you in advance for the assistance.

Sub MultiCSV_to_Tabs()
Dim vaFiles As Variant
Dim i As Long
Dim wbkToCopy As Workbook
Dim wbkToPaste As Workbook

vaFiles = Application.GetOpenFilename("CSV Files (*.csv), *.csv", _
          Title:="Select files", MultiSelect:=True)

'User_Created_File = "PLACE YOUR DIRECTORY AND FILE NAME IN BETWEEN THESE QUOTATION MARKS"

If IsArray(vaFiles) Then
    For i = LBound(vaFiles) To UBound(vaFiles)

        'Open the first CSV file in the list of selections
        Set wbkToCopy = Workbooks.Open(Filename:=vaFiles(i))

        'Split the vaFiles variable on backslashes to dissect the PathName and FileName
        SplitFileName = Split(vaFiles(i), "\")

        'Go find the last entry in the SplitFileName variable. This should be the exported file name we selected.
        ExportedCSVFileName = SplitFileName(UBound(SplitFileName))

        'Select all cells and copy that selection
        wbkToCopy.Application.DisplayAlerts = False
        Cells.Select
        Selection.Copy

        'Close the current workbook without saving changes
        wbkToCopy.Close savechanges:=False

        'Open the summary workbook
        Set wbkToPaste = Workbooks.Open(User_Created_File)

        'Add a new tab to the end of the last tab
        Sheets.Add After:=Sheets(Sheets.Count)

        'Define new sheetname using the parsed filename from the workbook
        shtname = Mid(ExportedCSVFileName, 17, 25)
        ActiveSheet.Name = shtname

        'Paste the selection we copied earlier
        wbkToPaste.Application.DisplayAlerts = False
        ActiveSheet.Paste

        wbkToPaste.Application.CutCopyMode = False

        'Close the summary workbook and save the changes. Go to the next file in the array.
        wbkToPaste.Close savechanges:=True

    Next i

End If

Set wbkToCleanUp = Workbooks.Open(User_Created_File)
Sheets("Sheet1").Delete
wbkToCleanUp.Close savechanges:=True
MsgBox ("Copy/Paste complete")

End Sub

Answer 1

Cells.Select is taking a lot of memory. Find the actual range of the sheet and copy that.

For example

Sub Sample()
    Dim ws As Worksheet
    Dim Lrow As Long, LCol As Long
    Dim rng As Range

    Set ws = Sheet1

    With ws
        '~~> Find Last row which has data
        Lrow = .Cells.Find(What:="*", _
                After:=wks.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

        '~~> Find Last column which has data                    
        LCol = .Cells.Find(What:="*", _
                After:=wks.Range("A1"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Column

        Set rng = .Range("A1:" & Split(Cells(, LCol).address, "$")(1) & Lrow)

        rng.Copy

        '~~> Paste where you want
    End With
End Sub

Also do not close the file before you paste it. You also have to be careful while pasting. Put the Copy command one line before you paste. Sometimes the clipboard clears up and you may face a problem.