Worksheets loop type mismatch error

Question

I'm getting "error13 type mismatch" when iterating over all worksheets in the workbook in line 7 of the code (If ActiveSheet.Cells(1, 47) = 1 Then). Does anyone know how to fix this?

Dim y As Integer
Dim c As Integer
Dim ws_num As Integer

Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
ws_num = ThisWorkbook.Worksheets.Count
For y = 1 To ws_num
    ThisWorkbook.Worksheets(y).Activate
    If ActiveSheet.Cells(1, 47) = 1 Then
        Worksheets("Podsumowanie").Cells(2, y + 1) = ThisWorkbook.Worksheets(y).Range("U2")
        Worksheets("Podsumowanie").Cells(3, y + 1) = ThisWorkbook.Worksheets(y).Range("V2")
        Worksheets("Podsumowanie").Cells(4, y + 1) = ThisWorkbook.Worksheets(y).Range("W2")

        Worksheets("Podsumowanie").Cells(5, y + 1) = ThisWorkbook.Worksheets(y).Range("P3")
        Worksheets("Podsumowanie").Cells(6, y + 1) = ThisWorkbook.Worksheets(y).Range("Q3")
        Worksheets("Podsumowanie").Cells(7, y + 1) = ThisWorkbook.Worksheets(y).Range("R3")
        Worksheets("Podsumowanie").Cells(8, y + 1) = ThisWorkbook.Worksheets(y).Range("S3")
    Else
        Worksheets("Podsumowanie").Cells(2, y + 1) = ThisWorkbook.Worksheets(y).Range("U2")
        Worksheets("Podsumowanie").Cells(3, y + 1) = ThisWorkbook.Worksheets(y).Range("V2")
        Worksheets("Podsumowanie").Cells(4, y + 1) = ThisWorkbook.Worksheets(y).Range("W2")

        Worksheets("Podsumowanie").Cells(5, y + 1) = ThisWorkbook.Worksheets(y).Range("P8")
        Worksheets("Podsumowanie").Cells(6, y + 1) = ThisWorkbook.Worksheets(y).Range("Q8")
        Worksheets("Podsumowanie").Cells(7, y + 1) = ThisWorkbook.Worksheets(y).Range("R8")
        Worksheets("Podsumowanie").Cells(8, y + 1) = ThisWorkbook.Worksheets(y).Range("S8")
    End If
Next

Answer 1

Try using this instead

Dim y As Long
Dim PodSheet As Worksheet

Set PodSheet = ThisWorkbook.Sheets("Podsumowanie")

For y = 1 To ThisWorkbook.Worksheets.Count
    With ThisWorkbook.Sheets(y)
        If .Cells(1, 47).Value2 = 1 Then
            PodSheet.Cells(2, y + 1) = .Range("U2")
            PodSheet.Cells(3, y + 1) = .Range("V2")
            PodSheet.Cells(4, y + 1) = .Range("W2")
            PodSheet.Cells(5, y + 1) = .Range("P3")
            PodSheet.Cells(6, y + 1) = .Range("Q3")
            PodSheet.Cells(7, y + 1) = .Range("R3")
            PodSheet.Cells(8, y + 1) = .Range("S3")
        Else
            PodSheet.Cells(2, y + 1) = .Range("U2")
            PodSheet.Cells(3, y + 1) = .Range("V2")
            PodSheet.Cells(4, y + 1) = .Range("W2")
            PodSheet.Cells(5, y + 1) = .Range("P8")
            PodSheet.Cells(6, y + 1) = .Range("Q8")
            PodSheet.Cells(7, y + 1) = .Range("R8")
            PodSheet.Cells(8, y + 1) = .Range("S8")
        End If
    End With
Next y

Answer 2

Type Mismatch error is caused when Cells(1, 47) contains an error - to avoid it use IsError() Another issue will be caused when the cell is empty or doesn't contain a number

You can also minimize repetition like in Tom's answer, and not .Activate each sheet
This contains all suggestions, but is not tested (you didn't include the full procedure)

---

Dim y As Long, c As Long, thisCol As Long, pCol As Long
Dim ws As Worksheet, podWs As Worksheet, cel As Range

Set podWs = ThisWorkbook.Worksheets("Podsumowanie")

For Each ws In ThisWorkbook.Worksheets
    With ws
        pCol = .Index + 1
        podWs.Cells(2, pCol) = .Range("U2")
        podWs.Cells(3, pCol) = .Range("V2")
        podWs.Cells(4, pCol) = .Range("W2")
        Set cel = .Cells(1, 47)
        If Not IsError(cel) Then
            If IsNumeric(cel.Value2) Then
                thisCol = IIf(cel = 1, 3, 8)
                podWs.Cells(5, pCol) = .Range("P" & thisCol)
                podWs.Cells(6, pCol) = .Range("Q" & thisCol)
                podWs.Cells(7, pCol) = .Range("R" & thisCol)
                podWs.Cells(8, pCol) = .Range("S" & thisCol)
            End If
        End If
    End With
Next