Hi,
I have a piece of code below that works a treat when exporting tabs to a new file as values only. However I ran into some trouble today when i changed one of the columns to have indirect formulas and now for some reason this code does not like it, it just copies them all across as blank. The tab the indirect function looks up is not getting copied across to the new sheet, not sure if this is the issue but if anyone has got any ideas it would be greatly appreciated
Sub Exportas()
Dim NewName As String
Dim nm As Name
Dim ws As Worksheet
If MsgBox("This will copy the sheets to a new workbook" & vbCr & _
"New sheets will be pasted as values and all source data will be removed" _
, vbYesNo, "Extract") = vbNo Then Exit Sub
With Application
.ScreenUpdating = False
' Copy specific sheets
On Error GoTo ErrCatcher
Sheets(Array("sheet1", "sheet2")).Copy
On Error GoTo 0
' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select
' Remove named ranges
For Each nm In ActiveWorkbook.Names
Next nm
' Input box to name new file
NewName = InputBox("Please Specify the name of your new workbook", "What do you want to call your new workbook?")
' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "" & NewName & ".xlsx"
'ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "" & NewName & ".pdf"
ActiveWorkbook.Close SaveChanges:=False
.ScreenUpdating = True
End With
Exit Sub
ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub
I have a piece of code below that works a treat when exporting tabs to a new file as values only. However I ran into some trouble today when i changed one of the columns to have indirect formulas and now for some reason this code does not like it, it just copies them all across as blank. The tab the indirect function looks up is not getting copied across to the new sheet, not sure if this is the issue but if anyone has got any ideas it would be greatly appreciated
Sub Exportas()
Dim NewName As String
Dim nm As Name
Dim ws As Worksheet
If MsgBox("This will copy the sheets to a new workbook" & vbCr & _
"New sheets will be pasted as values and all source data will be removed" _
, vbYesNo, "Extract") = vbNo Then Exit Sub
With Application
.ScreenUpdating = False
' Copy specific sheets
On Error GoTo ErrCatcher
Sheets(Array("sheet1", "sheet2")).Copy
On Error GoTo 0
' Paste sheets as values
' Remove External Links, Hperlinks and hard-code formulas
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select
' Remove named ranges
For Each nm In ActiveWorkbook.Names
Next nm
' Input box to name new file
NewName = InputBox("Please Specify the name of your new workbook", "What do you want to call your new workbook?")
' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "" & NewName & ".xlsx"
'ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "" & NewName & ".pdf"
ActiveWorkbook.Close SaveChanges:=False
.ScreenUpdating = True
End With
Exit Sub
ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub