Dim oBook As Workbook Excel.Application.DisplayAlerts = False Application.ScreenUpdating = False Me.btnExportWorkSheet.TakeFocus<nClick = False ' Delete the Old File Kill "c:\FileName.xls" ' Create a new blank workbook: Set oBook = Application.Workbooks.Add Application.SheetsInNewWorkbook = 1 ' Add a defined name to the workbook ' that RefersTo a range: oBook.Names.Add Name:="tempRange", RefersTo:="=Sheet1!$A$1" ' Save the workbook: oBook.SaveAs "c:\FileName.xls" ' Select the Workbook where the Worksheet to be copied is located Workbooks("Old File.xls").Activate Workbooks("Old File.xls").Worksheets("Work Sheet A").Activate ' Copy the Worksheet to the Workbook Worksheets("Work Sheet A").Copy Before:=Workbooks("New Work Book.xls").Sheets(1) Dim xRange As Range, adr As String Workbooks("New Work Book.xls").Worksheets("Work Sheet A").Activate Workbooks("New Work Book.xls").Worksheets("Work Sheet A").Range("a1:z100").Activate ' Remove Links and Replace with Cell Values With Workbooks("New Work Book.xls").Worksheets("Work Sheet A") Dim cCell As Range Dim strValue As String Set xRange = .Range("a1:z100") For Each cCell In xRange ' Save the value to use as a means to identify what cells to change strValue = CStr(cCell.Value) If InStr(strValue, "/") > 0 Then cCell = CStr(cCell.Value) End If Next End With ' Select the next Workbook where the Worksheet to be copied is located Workbooks("Old File.xls").Activate Workbooks("Old File.xls").Worksheets("Work Sheet B").Activate ' Copy the Worksheet to the Workbook Worksheets("Work Sheet B").Copy Before:=Workbooks("CashFlowInput&DollarChart.xls").Sheets(1) ', UpdateLinks:=0 Workbooks("New Work Book.xls").Worksheets("Work Sheet B").Activate Workbooks("New Work Book.xls").Worksheets("Work Sheet B").Range("a1:z100").Activate ' Remove Links and Replace with Cell Values With Workbooks("New Work Book.xls").Worksheets("Dollars Chart") Set xRange = .Range("a1:z100") For Each cCell In xRange ' Save the value to use as a means to identify what cells to change ' cCell.Formula will show the link back to the Original Workbook strValue = CStr(cCell.Formula) If InStr(strValue, "!") > 0 Then cCell = CStr(cCell.Value) ' If cCell = .Range("b51") Or cCell = .Range("m4") Then ' Stop ' End If End If Next End With MsgBox ("Your Worksheets have been copied to C:\New Work Book.xls") End Sub
Read and share knowledge about Asp.Net, SharePoint, JavaScript and other Microsoft Technology.
Friday, December 25, 2009
Programatically copy worksheet via VBA in Excel
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment