Sub Chbx()
Dim shp As Shape, ws As Worksheet, msg As String, c As Integer
Dim cop
c = 1
With Sheets("Summary")
cop = .Rows(1).Value
.Cells.ClearContents
.Rows(1).Value = cop
End With
For Each ws In ActiveWorkbook.Worksheets
If Not ws.Name = "Summary" Then
For Each shp In ws.Shapes
If shp.Type = msoFormControl Then
If shp.FormControlType = xlCheckBox Then
If shp.ControlFormat.Value = 1 Then
c = c + 1
' Alter "Resize" number below for the number of cells across, to copy over.
ws.Range(shp.ControlFormat.LinkedCell).Offset(, 1).Resize(, 10).Copy Sheets("Summary").Cells(c, 1)
End If
End If
End If
Next shp
End If
Next ws
End Sub
Experts Exchange (EE) has become my company's go-to resource to get answers. I've used EE to make decisions, solve problems and even save customers. OutagesIO has been a challenging project and... Keep reading >>
Our community of experts have been thoroughly vetted for their expertise and industry experience.
The Most Valuable Expert award recognizes technology experts who passionately share their knowledge with the community, demonstrate the core values of this platform, and go the extra mile in all aspects of their contributions. This award is based off of nominations by EE users and experts. Multiple MVEs may be awarded each year.
This award recognizes a member of Experts Exchange who has made outstanding contributions to the community within their first year as an expert. The Rookie of the Year is awarded to a new expert who has the highest number of quality contributions.