Copy from multiple workbooks, rename, and overwrite if exists

[caimakale]

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

 

[Tim Williams]

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?

 

[caimakale]

I like what it is doing now (copying and renaming), but if the
worksheet already exists in the master workbook, replace it with the
new worksheet (delete then copy I guess?). I don't want any warnings,
I will be updating the master worksheet every couple days and don't
want to be prompted when updated.

 

[Tim Williams]

Try this (untested)

Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets("Contract Summary")

application.displayalerts=false
On Error Resume Next
ThisWorkbook.sheets(.Range("E5").Value).delete
on error goto 0
application.displayalerts=true

.Name = .Range("E5").Value

.UsedRange.Value = .UsedRange.Value
.Copy after:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)

 

[caimakale]

That worked perfect!!! Thanks!