Very slow execution of VBA code during getting the list of all worksheet names in an Excel Workbook

user_18100211 0
Viewed 80

I need to work on the workbook in Excel that contains hundreds of specific worksheets. I created this simple code to get the list of names of all these worksheets in the one called "Spis faktur". The code runs well but is horribly slow. It seems like it executed the one name of specific worksheet in 0,3 second so it takes ages before it finishes to executed the of all names of worksheets.

Sub ListSheets() 
Dim sh As Worksheet
Const txt = "Spis faktur"

Set sh = Sheets(txt)
  For i = 1 To Worksheets.Count
      sh.Cells(i + 1, 1) = ThisWorkbook.Sheets(i).Name
  Next i
End Sub

Would be grateful for any piece of advice what could be wrong with this code.

worksheet execution vba excel performance
1 Answers

List All Worksheet Names

    Option Explicit
    
    Sub ListWorkSheets()
        
        Const dName As String = "Spis faktur"
        Const dfCellAddress As String = "A2"
        
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

        Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
        Dim wsnCount As Long: wsnCount = wb.Worksheets.Count
        
        Dim WorksheetNames() As String: ReDim WorksheetNames(1 To wsnCount, 1 To 1)
        
        Dim sws As Worksheet
        Dim n As Long
        
        ' Write to array.
        For Each sws In wb.Worksheets
            n = n + 1
            WorksheetNames(n, 1) = sws.Name
        Next sws
    
        ' Write to range.
        Dim dfCell As Range: Set dfCell = dws.Range(dfCellAddress)
        Dim drg As Range: Set drg = dfCell.Resize(wsnCount)
        drg.Value = WorksheetNames
    
        ' Clear below.
        Dim dclrrg As Range: Set dclrrg _
            = drg.Resize(dws.Rows.Count - drg.Row - wsnCount + 1).Offset(wsnCount)
        dclrrg.ClearContents ' or dclrrg.Clear
    
    End Sub
user_98140690
Related