VBA/Excel/Access/Word/Excel/Worksheets

Do... Loop Until Loops with Worksheets

 
 Sub Create_Worksheets()
     Dim strNewSheet As String
     Do
         strNewSheet = "asdf"
         If strNewSheet <> "" Then
             ActiveWorkbook.Worksheets.Add
             ActiveSheet.Name = strNewSheet
         End If
     Loop Until strNewSheet = ""
 End Sub

Dynamic Arrays for worksheet name

 
Option Base 1
Sub MySheets()
    Dim myArray() As String
    Dim myCount As Integer, NumShts As Integer
    
    NumShts = ActiveWorkbook.Worksheets.count
    ReDim myArray(1 To NumShts)
    
    For myCount = 1 To NumShts
        myArray(myCount) = ActiveWorkbook.Sheets(myCount).name
    Next myCount
    
End Sub

For...Next Loop with Worksheet

 
     Sub FilePathInFooter()
         Dim i As Integer, sFilePath As String
         sFilePath = ActiveWorkbook.FullName
         For i = 1 To Worksheets.Count Step 1
             Worksheets(i).PageSetup.CenterFooter = sFilePath
         Next i
     End Sub

Grouping Worksheets

 
     Sub GroupSheets()
         Dim asNames(1 To 3) As String
         Dim i As Integer
         asNames(1) = "Jan 2007"
         asNames(2) = "Mar 2007"
         asNames(3) = "May 2007"
         Worksheets(asNames(1)).Select
         For i = 2 To 3
         Worksheets(asNames(i)).Select Replace:=False
         Next i
     End Sub

Looping Through Worksheets in a Workbook

 
Sub WorksheetLoop() 
    Dim nIndex As Integer 
    For nIndex = 1 To ThisWorkbook.Worksheets.Count 
        Debug.Print ThisWorkbook.Worksheets(nIndex).Name 
    Next 
End Sub

move the second worksheet to end of workbook

 
Sub SimpleWorksheetMovement() 
    ThisWorkbook.Worksheets(2).Move after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 
End Sub

performs a simple bubble sort to sort the worksheets in the workbook

 
Sub AlphabetizeWorksheets()
    Dim bSorted As Boolean
    Dim nSheetsSorted As Integer
    Dim nSheets As Integer
    Dim n As Integer
    Dim wb As Workbook
    
    Set wb = ActiveWorkbook
    nSheets = wb.Worksheets.Count
    nSheetsSorted = 0
    Do While (nSheetsSorted < nSheets) And Not bSorted
        bSorted = True
        nSheetsSorted = nSheetsSorted + 1
        For n = 1 To nSheets - nSheetsSorted
            If StrComp(wb.Worksheets(n).name, wb.Worksheets(n + 1).name, vbTextCompare) > 0 Then
                wb.Worksheets(n + 1).Move _
                    before:=wb.Worksheets(n)
                bSorted = False
            End If
        Next
    Loop
End Sub

Sort all worksheets

 
Sub SortAllSheets()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim cSheets As Integer
    Dim sSheets() As String
    Dim i As Integer
    Set wb = ActiveWorkbook
    
    cSheets = wb.Sheets.Count
    ReDim sSheets(1 To cSheets)
    
    For i = 1 To cSheets
      sSheets(i) = wb.Sheets(i).Name
    Next
    
    Set ws = wb.Worksheets.Add
    For i = 1 To cSheets
      ws.Cells(i, 1).Value = sSheets(i)
    Next
    
    ws.Columns(1).Sort Key1:=ws.Columns(1), _
       Order1:=xlAscending
    
    For i = 1 To cSheets
      sSheets(i) = ws.Cells(i, 1).Value
    Next
    
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
    
    For i = 1 To cSheets
      wb.Sheets(sSheets(i)).Move After:=wb.Sheets(cSheets)
    Next
    
End Sub

The Sheets Collection

 
     Sub WorksheetIndex()
           Dim i As Integer
           For i = 1 To ThisWorkbook.Worksheets.Count
           MsgBox ThisWorkbook.Worksheets(i).name & _
                 " has Index = " & _
                 ThisWorkbook.Worksheets(i).Index
           Next i
     End Sub

Use for loop to loop through all worksheets

 
Sub macro_loop4()
  Dim i
  For i = 1 To ThisWorkbook.Worksheets.Count
    Debug.Print ThisWorkbook.Worksheets(i).Name
  Next i
End Sub