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:
Comments (Atom)