Prev: opening a subform to a specific record?
Next: Copy files with Microsoft encryption enabled
From: JamesDMB on 21 Mar 2007 14:13
Hi,

I spent the last 2days scouring the Internet looking for ways to
accomplish this. I used some of what I found, but then modified it to
work as I needed it to. You should be able to use this without much
hassle. Just rename to your Workbook.Worksheets and make sure your
changing only those values you need to. The way I did this doesn't
remove any Formulas on the worksheet; Only Links.

The Code:

Dim oBook As Workbook

Excel.Application.DisplayAlerts = False
Application.ScreenUpdating = False

Me.btnExportWorkSheet.TakeFocusOnClick = 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

 | 
Pages: 1
Prev: opening a subform to a specific record?
Next: Copy files with Microsoft encryption enabled