You don't say what you'd like it to do instead....

Should it skip the copy if a sheet already exsits with the same name, pop up an alert, or what?

--
Tim Williams
Palo Alto, CA


wrote in message ups.com...
I need some help with code. I have posted what I have so far (it was
found on the net, it's not my own), but maybe I am going in the wrong
direction. Here is what I am doing. I have multiple excel files in
multiple directories, with more workbooks being added all the time.
Each workbook contains the exact same three sheets of which I only
need to copy "Contract Summary", which is the summary of each
workbook, into one master workbook. Since all the sheets are named
"Contract Summary", I will need them to be renamed to the value in
cell E5 so I can distinguish them from each other. The code below
works great if no worksheets exist, but if I have already copied all
sheets, it adds the sheet and renames it with a (2) at the end. So
rather than it being "Blah" it's "Blah (2)" and "Blah" still exists
with the old data.

Any suggestions?

Sub GetSheets()

Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim sh As Object
Dim mybook As Workbook
Dim myExistingPath As String
Dim myPathToRetrieve As String

myExistingPath = CurDir

ChDrive myPathToRetrieve

varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

Application.ScreenUpdating = False

If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets("Contract Summary")
On Error Resume Next
.Name = .Range("E5").Value
.UsedRange.Value = .UsedRange.Value
.Copy after:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)

End With
wkbk.Close SaveChanges:=False
Next
End If

Application.ScreenUpdating = True

'reset it back
ChDrive myExistingPath

End Sub