loops through sheets and Find, offset, copy and past into a summary sheet

[Stan101]

I am attempting to create a summary sheet in a workbook that will hold several pieces of info. I can break it down into 2 parts.

1. Starting in cell A2 in the summary sheet, the names of all the sheets in the workbook get listed down the column. The following code seems to work. I have not built in any error prevention yet.

Sub SummaryNames()


Dim wsheet As Worksheet

With ThisWorkbook.Sheets("Summary")
    Set nextSheetNameEntry = .Range("A2")
    For Each wsheet In ThisWorkbook.Sheets
        If wsheet.Name <> "Summary" Then
            nextSheetNameEntry.Value = wsheet.Name
            Set nextSheetNameEntry = nextSheetNameEntry.Offset(1, 0)
            
            
        End If
        
  
        
    Next wsheet
    
    
    
End With

End Sub

2. As I loop through each of the sheets, I want to find a known word that will be in a single cell somewhere in each sheet. after finding the word, I want to offset to the right 3 cells, copy the cell contents and then paste as a value only into the summary page. To match with the sheet naming in part 1, I will start the pasting in cell B2 of the summary page. Here is the latest code that I have cobbled together and get errors with.

Sub SummaryFigures5()
    
    
With ThisWorkbook.Sheets("Summary")
    Set TotalHouseEntry = .Range("B2")
 

    'set this variable based on what is found: (note we remove the 'activate' here
    Set TotalHouseEntry = Cells.Find(What:="Houses", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)

    'You can copy now and do whatever you want. Say you want to copy these values to Sheet2!A1 and B1, respectively:
    Set TotalHouseEntry.Value = TotalHouseEntry.Offset(0, 3).Value
    
    Sheets("Summary").Select
    Range("B2").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
    Set TotalHouseEntry = TotalHouseEntry.Offset(1, 0)
    
    
   
    
End With
    
  Next wsheet  

End Sub

This throws up error " Run-Time Error 91. Object variable or With block variable not set"

Also this code doesn't work. I have attempted it to loop through all the sheets but it fails after the first.

Sub Try4()
Dim fCell As Range
Dim wsheet As Worksheet


With ThisWorkbook.Sheets("Summary")

For Each wsheet In ThisWorkbook.Sheets
Set fCell = Cells.Find(What:="Total No of Houses in", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart)

If Not fCell Is Nothing Then
  
  fCell.Offset(0, 3).Copy
  
  Sheets("Summary").Select
    Range("B2").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
  

  
End If

Next wsheet

End With

End Sub

I realise my code is terrible but I would really like to find a solution. I have many of these types of spreadsheets and would like to pull several cells of data out of them. If I can get the loop working and error proof, I can use it for a template to add other cells of data into the summary.

Any ideas?

 

[DanteAmor]

Try this:

Sub loops_through_sheets_get_values()
  Dim sh As Worksheet, shsum As Worksheet
  Dim f As Range
  Dim i As Long
  
  Set shsum = Sheets("Summary")
  i = 2
  For Each sh In Sheets
    If sh.Name <> shsum.Name Then
      shsum.Range("A" & i).Value = sh.Name
      Set f = sh.Cells.Find("Houses", , xlValues, xlPart, , , False)
      If Not f Is Nothing Then
        shsum.Range("B" & i).Value = f.Offset(0, 3).Value
      End If
      i = i + 1
    End If
  Next
End Sub

 

[Stan101]

Try this:

DanteAmor,​

thank you for such succinct code that I can use but also learn from. Am I correct that here:

      shsum.Range("A" & i).Value = sh.Name

the code is checking for a worksheet name in column A (created with my sub "SummaryNames") and matching that to the worksheet that the the data will be pulled from as a double check?

I added Sub loops_through_sheets_get_values into Sub SummaryNames and it works well. Thank you for your guidance.

Sub SummaryNames()


Dim wsheet As Worksheet

With ThisWorkbook.Sheets("Summary")
    Set nextSheetNameEntry = .Range("A2")
    For Each wsheet In ThisWorkbook.Sheets
        If wsheet.Name <> "Summary" Then
            nextSheetNameEntry.Value = wsheet.Name
            Set nextSheetNameEntry = nextSheetNameEntry.Offset(1, 0)
            
            
        End If
        
  [B]loops_through_sheets_get_values[/B]
        
    Next wsheet
    
    
    
End With

End Sub

 

[DanteAmor]

the code is checking for a worksheet name in column A (created with my sub "SummaryNames") and matching that to the worksheet that the the data will be pulled from as a double check?

No, my macro does not consider the names you have in the summary sheet at all.
In fact, I skipped that part because it is not necessary.
My macro reads all the sheets and writes the names and values, both at the same time.

 

[Stan101]

Thanks, I did see that when I looked deeper. (And I do often need to look more intently). I see what is happening. But thanks again.

 

[DanteAmor]

Im glad to help you. Thanks for the feedback