Loop through all worksheets and copy certain tab names.

Question

QUESTION: I need to prepare a summary in a separate worksheet that lists down the worksheet names in the same folder. However, not all the worksheet names should be copied (like Appendix and etc.). How can I do so since the worksheet names to be copied may also vary? One thing to differentiate is that each of the worksheet has a cell that contains a string, namely "Total TCs:".

ANSWER: Rj,

I assume you are talking about worksheets in the same workbook. However, you use the term "same folder" which isn't usually associated with internal to a workbook, but workbooks in a directory on a drive. However, the rest of your question appears to speak of worksheets in a workbook so I will assume that. This code shows how to loop through worksheets in a workbook and decide whether they contain the words "Total TCs:" in a cell or not

Dim sh as worksheet

 for each sh in ActiveWorkbook.Worksheets
   if application.Countif(sh.Cells,"*Total TCs:*") > 0 then
           ' the sheet contains "Total TCs:"

   else
           ' the sheet does not contain "Total TCs:"

   end if
 Next

so within each leg of the if statement, you have a reference to the worksheet with the variable sh.

if you wanted to write that to the next cell in column A of a sheet named summary you could do

 worksheets("Summary").Cells(rows.count,"A").End(xlup).offset(1,0).Value = sh.name

as an example.

If this doesn't answer your question, then post back with a clarification of your situation and what you want to do.

---------- FOLLOW-UP ----------

QUESTION: Oh, my apology for confusing you. Well, what I meant was: how to loop through inactive worksheets in different workbooks (of the same folder) and return the worksheet names that contain "Total TCs:"?

ANSWER: Rj,

>worksheet names that contain "Total TCs:"?

I assume you mean worksheet names for sheets that contain the string "Total TCs:"

Sub loopfiles() Dim sName As String, sPath As String Dim sh As Worksheet, rw As Long, sh1 As Worksheet Dim bk As Workbook

Set sh = ActiveSheet rw = 2 sPath = ThisWorkbook.Path

If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

sName = Dir(sPath & "*.xls") Do While sName <> ""

If LCase(sName) <> LCase(ThisWorkbook.Name) Then
 Set bk = Workbooks.Open(sPath & sName)
 For Each sh1 In ActiveWorkbook.Worksheets
  If Application.CountIf(sh1.Cells, "*Total TCs:*") > 0 Then
          ' the sheet contains "Total TCs:"
     sh.Cells(rw, 1) = bk.Name
     sh.Cells(rw, 2) = sh1.Name
     rw = rw + 1
  End If
 Next
 bk.Close SaveChanges:=False
End If
sName = Dir()

Loop End Sub

---------- FOLLOW-UP ----------

QUESTION: Thanks Tom for the clarification :D

Anyways, I have another issue. I couldn't figure out how to copy the value below the cell that contains ("Total TCs":) and return it to the summary worksheet. Could you please help me out?

Answer

Rj,

Sub loopfiles() Dim sName As String, sPath As String Dim sh As Worksheet, rw As Long, sh1 As Worksheet Dim bk As Workbook, rng as Range

Set sh = ActiveSheet rw = 2 sPath = ThisWorkbook.Path

If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

sName = Dir(sPath & "*.xls") Do While sName <> "" If LCase(sName) <> LCase(ThisWorkbook.Name) Then

Set bk = Workbooks.Open(sPath & sName)
For Each sh1 In ActiveWorkbook.Worksheets
 If Application.CountIf(sh1.Cells, "*Total TCs:*") > 0 Then
         ' the sheet contains "Total TCs:"

     Set rng = sh1.cells.Find(What:="Total TCs:", _
          After:=sh1.Range("A1"), _
          LookIn:=xlValues, _
          LookAt:=xlPart, _
          SearchOrder:=xlByRows, _
          SearchDirection:=xlNext, _
          MatchCase:=False)

    sh.Cells(rw, 1) = bk.Name
    sh.Cells(rw, 2) = sh1.Name
    if not rng is nothing then
       sh1.cells(rw,3).Value = rng.offset(1,0).Value
    end if
    rw = rw + 1
 End If
Next
bk.Close SaveChanges:=False

End If sName = Dir() Loop End Sub