Copy from multiple workbooks, rename, and overwrite if exists
 

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

Copy from multiple workbooks, rename, and overwrite if exists
 

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

Copy from multiple workbooks, rename, and overwrite if exists
 

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.

Copy from multiple workbooks, rename, and overwrite if exists
 

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)


--
Tim Williams
Palo Alto, CA


wrote in message oups.com...
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.

Copy from multiple workbooks, rename, and overwrite if exists
 

That worked perfect!!! Thanks!