Unless your sheets are grouped in some way, I don't see how your code would
paste to each sheet. Maybe I am missing something.

--
Regards,
Tom Ogilvy

"Nigel Brown" wrote in message
om...
Please can someone explain why the following code is pasting to every
sheet in the workbook. I am trying to select a range from one workbook
and paste to another creating an unique sheet name on each paste and
then listing key info from each sheet into a summary sheet. This seems
to work fine until looking at the sheets and realizing that the last
pasted info gets pasted to every sheet in the workbook overwriting
what was previously there.
Here is the code:

Sub saveToLib()
Application.DisplayAlerts = False
Workbooks("Output.xls").Sheets("Summary").Activate
Range("B2:N73").Select
Selection.Copy 'Select the range to be pasted
str = ActiveSheet.Range("K4").Value & ActiveSheet.Range("H4").Text
& Left(ActiveSheet.Range("H3"), 10)
i = InStr(1, str, ":")
str = Left(str, i - 1) & Mid(str, i + 1)
Do While InStr(1, str, "/") < 0
i = InStr(1, str, "/")
str = Left(str, i - 1) & Mid(str, i + 1) 'Create the unique
name for the sheet
Loop
Call openLib 'A simple sub that opens and activates the ResultLib
workbook
For Each sht In Workbooks("ResultLib.xls").Sheets
If sht.Name = str Then Exit Sub 'If the sheet name is not
unique exit
Next
Sheets.Add
ActiveSheet.Name = str
ActiveSheet.Range("B2:N73").PasteSpecial 'This should only paste
to one sheet, but is currently pasting to all the sheets in the
workbook
Sheets("Summary").Activate
Range("A1").Select
i = 1
For Each c In ActiveSheet.Columns(1).Cells
If Application.CountA(c.EntireRow) = 0 Then 'Find the first
empty row in the sheet and write key info to the summary
str1 = "A" & i
str2 = "B" & i
str3 = "C" & i
str4 = "D" & i
Range(str1).Value = Sheets(str).Range("K4").Text
Range(str2).Value = Left(Sheets(str).Range("H3").Value,
10)
Range(str3).Value = Sheets(str).Range("H4").Text
Range(str4).Value = Sheets(str).Range("K5").Text
'Workbooks("ResultLib.xls").Close savechanges:=True
'Workbooks("Output.xls").Close savechanges:=True
Exit Sub
End If
i = i + 1
Next

Application.DisplayAlerts = True
End Sub