Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy from multiple workbooks, rename, and overwrite if exists
That worked perfect!!! Thanks!
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
HOW DO I COPY AND RENAME A WORKBOOK LINKED TO OTHER WORKBOOKS | Excel Discussion (Misc queries) | |||
Rename Multiple Excel Workbooks based on cell contents | Excel Discussion (Misc queries) | |||
macro: copy multiple workbooks to multiple tabs in single book | Excel Programming | |||
Rename sheet if exists | Excel Programming | |||
Copy worksheet from multiple files in one DIR to another DIR & rename | Excel Programming |