VBA - Go through Worksheets and end with one sheet with found strings, from all Sheets - vba

Question

I can't get this code to work. I am trying to go through all worksheets in a Excel Book, And when I find a row that contains "Syst" it is supposed to pop up in a list in the worksheet "Systemoversikt"
Sub WorksheetLoop()
MsgBox "Testing"
Dim WS_Count As Integer, j As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For j = 1 To WS_Count
Dim sh As Worksheet
Dim i As Long
Set sh = ActiveWorkbook.Worksheets(j)
sh.Activate
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim n As Integer
For i = 1 To LastRow
n = 3
Dim systemnummer As String
systemnummer = Left(Cells(i, 1).Value, [4])
If systemnummer = "Syst" Then
Sheets("Systemoversikt").Cells(n, 8).Value = Cells(i, n).Value
n = n + 1
End If
Next i
Next j
End Sub

Answer 1

I think your search and loop method needs improvement. Here's a simplified version. It's not as fast and efficient as using a find function, but I think it gets you what you need.
Sub WorksheetLoop()
Dim SearchWkb As Workbook
Dim DestWkb As Workbook
Set SearchWkb = ActiveWorkbook
Set DestWkb = Workbooks("Punktliste11.xlsm") 'updated!
'Begin loop through sheets
Dim sh As Worksheet
Dim vCell As Range
For Each sh In SearchWkb.Sheets
If sh.Name <> "Systemoversikt" Then
'Look through all activerange cells (this could be done faster but good for illustration)
For Each vCell In sh.UsedRange.Cells
If Left(vCell.Value, 4) = "Syst" Then
DestWkb.Sheets("Systemoversikt").Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).Value = vCell.Value
End If
Next vCell
End If
Next sh
End Sub