asked on
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