Public Sub www()
    Dim i&, lr&, j&, a, b
    a = Array(1, 6, 16, 40, 46)
    For i = 4 To ThisWorkbook.Sheets.Count
        With Sheets(i)
            lr = Sheets(3).[a65536].End(xlUp)(2).Row
            For j = 0 To 4
                b = Intersect(.Range("6:" & .Cells(.Rows.Count, 1).End(xlUp).Row), .Columns(a(j)))
                Sheets(3).Cells(lr, j + 2).Resize(UBound(b), 1) = b
            Next
            Sheets(3).Cells(lr, 1).Resize(UBound(b), 1) = Sheets(i).Name
        End With
    Next
End Sub