A macro to Count the number of rows across all worksheets

Hi All,
Need some help in coming up with a VBA. A summary worksheet which would print all the worksheet names and counts of all the used rows(After row 7) of the worksheets. I also want to exclude the worksheets like table of contents.

WorkBook  with worksheets: Instructions, Table of contents, Abc1, Abc2, Abc3, Abc4, ............

Summary Worksheet would display:
Worksheet     Counts
Abc1                     20
Abc2                   100    
Abc3                   217
Abc4                   530

Total                   867

The below code has some limitations like excluding the desired worksheet and the rows after row number 7 needs to be taken into consideration.

Function Test_It()
    For Each Sheet In ThisWorkbook.Sheets
        Debug.Print Sheet.Name & vbTab & CountMyRows(Sheet.Name)
    Next Sheet
End Function

Function CountMyRows(SName) As Long         '# where SName is the name of a sheet
    Dim rowCount As Long
    rowCount = Worksheets(SName).UsedRange.Rows.Count
    CountMyRows = rowCount
End Function

Thanks in advance
Milind AgarwalAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

Subodh Tiwari (Neeraj)Connect With a Mentor Excel & VBA ExpertCommented:
Please try this to see if this is what you are trying to achieve....

Sub CreateSummarySheet()
Dim sws As Worksheet, ws As Worksheet
Dim slr As Long
Dim Found As Boolean
Application.ScreenUpdating = False
On Error Resume Next
Set sws = Sheets("Summary")
On Error GoTo 0
If sws Is Nothing Then
   Sheets.Add(Before:=Sheets(1)).Name = "Summary"
   Set sws = ActiveSheet
End If
With sws.Range("A1:B1")
   .Value = Array("Worksheet", "Count")
   .Font.Bold = True
   .Font.Size = 12
End With
For Each ws In Worksheets
   If ws.Name <> sws.Name And Not LCase(ws.Name) Like "table of content*" Then
      If ws.UsedRange.Rows.Count > 7 Then
         Found = True
         sws.Range("A" & Rows.Count).End(3)(2).Value = ws.Name
         sws.Range("B" & Rows.Count).End(3)(2).Value = ws.UsedRange.Rows.Count - 7
      End If
   End If
Next ws
If Found Then
   slr = sws.Cells(Rows.Count, 1).End(xlUp).Row
   With sws.Range("A" & slr + 1 & ":B" & slr + 1)
      .Value = Array("Total", Application.Sum(sws.Columns(2)))
      .Font.Bold = True
      .Font.Size = 12
   End With
   sws.Range("A1").CurrentRegion.Borders.Color = vbBlack
End If
Application.ScreenUpdating = True
End Sub

Open in new window

Milind AgarwalAuthor Commented:
Worked like a dream
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Milind! Glad to help.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.