PDA

View Full Version : Solved: Copy Multiple sheets with filtered value.



aloy78
08-11-2011, 01:12 AM
Hi all,
I've trying to look for a code that basically copy 2 of my sheets to a new workbook and save it to a filename of my choice. I've tried a sample file that was posted in this forum.

However when i do a filter and try to copy it, it end up copying everything ignoring the filtered. I think the code syntax may revolve around the special cell visible thingy. Maybe i could be wrong.

Btw, I've post a sample file to better describe what i want.

Anyone can help :) thanks in advance. cheers.

Bob Phillips
08-11-2011, 01:49 AM
What code are you using?

aloy78
08-11-2011, 07:19 PM
I got the codes from this site.

Here's the code


Option Explicit
Sub TwoSheetsAndYourOut()
Dim NewName As String
Dim nm As Name
Dim ws As
Worksheet
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("Sheet Name", "Another sheet name", "And Another"))
' Sheet names go inside quotes, seperated by commas
On Error GoTo ErrCatcher
Sheets(Array("Copy Me", "Copy Me2")).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.[A1].PasteSpecial
Paste:=xlFormats
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
' Input box to name new file
NewName = InputBox("Please Specify the name of your new workbook", "New Copy")
' Save it with the NewName and in the same directory as original
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xlsx"
ActiveWorkbook.Close
SaveChanges:=False
.ScreenUpdating = True
End With
Exit Sub

ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"
End Sub


I wanted to apply the code found in the sample file into my workbook.

aloy78
08-30-2011, 12:44 AM
Thread closed.

Same as this
http://www.vbaexpress.com/forum/showthread.php?t=38734