My workbook contains 100 wource wkshts identical except for contents
of cells. My code adds a new "Summary" wksht where I want to be able
to paste values and numbers only from the same range in each of the
other 100 wkshts in the wkbook. I want to loop thru each sht in the
workbook and:

1) Unprotect the source sht (password is "mbt"), then
2) Select a range ("G256:AD259") in the source sht, then
3) Paste only the cell values and number formats from that range into
the "Summary" wksht starting in cell "c3", then
4) place the name of the source sht in cell "b3", then
4) Go to next source wksht, copy the same range ("G256:AD259), and
paste those cell values and number formats into the next blank row
below what was just pasted, and
6) Continue the process until the copyrange & paste special has looped
thru all of the 100 source wksht.

I have gathered snipets of code that seem to almost work, but the use
of destination cell seems inappropriate for PasteSpecial purposes.
What I want to do is: Go to first source wksht - CopyRange - go to
cell "c3" in "Summary" and PasteValuesAndNumberFormat - place source
the wksht name for that source wksht into cell "b3" of "Summary", and
then loop through all of the remaining worksheets. Can someone correct
my code? TIA

Mike Taylor

---------------------------------------------------------------------------

Sub SummaryWkshtsAll()

Dim sht As Worksheet
Dim SummSht As Worksheet
Dim destCell As Range
Dim CopyRange As Range
Dim iRow As Long
Dim testRange As Range

Set SummSht = ActiveWorkbook.Sheets.Add
SummSht.Name = "0Summary"
Set destCell = SummSht.Range("b4")

For Each sht In ActiveWorkbook.Worksheets
With sht
If .Name < "Summary" Then
If Not IsEmpty(.Range("a256")) Then
Set CopyRange = .Range("g256:ad" & .Cells(259,
"G").End _(xlUp).Row) '.Range("g256", .Range("g256").End(xlDown))

'Set CopyRange = .Range("G256:AD259")
For iRow = 257 To 259
Set testRange = .Range(.Cells(iRow, "G"),
..Cells _(iRow, "AD"))
If Application.CountG(testRange) 0 Then
Set CopyRange = Union(CopyRange, testRange)
End If
Next iRow
'Set testRange = Intersect(CopyRange, .Columns(1))
destCell.Offset(0,
-1).Resize(CopyRange.Cells.Count, _ 1).Value = .Name
CopyRange.Copy Destination:=destCell
Set destCell = SummSht.Cells(SummSht.Rows.Count,
"b").End(xlUp).Offset(1, 0)
End If
End If
End With
Next sht
End Sub