Export Worksheets from Source Workbook into a new Workbook

**dhaval3547** · 12-31-2012, 10:51 AM

Hi everyone,

I was wondering if someone can please help me with a VBA code to export worksheets from source workbook to a new workbook. Please see below specific points for what I have and what I need, apologies in advance if I this is not very clear.

What I have;
A source workbook with 6 worksheets named A, B, C, D, E and F
Few Rows are hidden & Data is filtered
There are extrernal links within the source workbook

What I need;
Export only visible cells from worksheet B, C and D into a new workbook
Retain the data into its seperate worksheets in the new workbook
Delete any external links in the new workbook
Copy & Paste Special Value data
Column Width and Row Height should stay as it is.
All the formats should stay as it is apart from any 'Fill Colour' which needs to be 'No Fill'

Thanks for your help

**Mudhafar.M** · 12-31-2012, 01:48 PM

"Dear dhaval i hope that the below will help you:"

Sub CopyPasteSave()
Dim NewName As String
Dim nm As Name
Dim ws As Worksheet
Dim Path As String
Path = "D:\"  ' Enter the path of your new WorkBook


If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
"New sheets will be pasted as values, named ranges removed" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub

With Application
.ScreenUpdating = False

' Copy specific sheets
' *SET THE SHEET NAMES TO COPY BELOW*
' Array("Sheet1", "Sheet2"))
' Sheet names go inside quotes, seperated by commas
On Error GoTo ErrCatcher
Sheets(Array("Sheet1", "sheet2", "sheet3", "sheet4", "sheet5", "sheet6")).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
Application.DisplayAlerts = False

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
nm.Delete
Next nm

' Saves the WorkBook as where you specified
ActiveWorkbook.SaveAs Filename:=Path & " " & "Name of the new work sheet" & " " & ".xls"
ActiveWorkbook.Close SaveChanges:=True

.ScreenUpdating = False




End With
Exit Sub

ErrCatcher:
MsgBox "specified sheets do not exist within this work book"
End Sub

**dhaval3547** · 01-02-2013, 06:16 AM

Hi Mudhafar,

Thanks for this code, unfortunately this stops at code line 'ws.[A1].PasteSpecial Paste:=xlValues' and its also copies over all the hidden and filtered data as well. I kind of wanted only visible cells to be copied over.

I've got this alternative code, which does everthing apart from retaining Column Width and Row Hieght.

Is it possible to amend this below code so that we can retain column width and row height?

Thanks

Sub Copy_B_C_D()

Dim wb As Workbook, ws As Worksheet, i As Long

Application.ScreenUpdating = False

i = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 3
Set wb = Workbooks.Add
Application.SheetsInNewWorkbook = i

i = 1
For Each ws In ThisWorkbook.Worksheets(Array("B", "C", "D"))
With wb.Sheets(i)
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=.Range("A1")
.UsedRange.Value = .UsedRange.Value
.Cells.Interior.ColorIndex = xlNone
.Name = ws.Name
i = i + 1
End With
Next ws

Application.ScreenUpdating = True

MsgBox "Export Complete"

End Sub