Current Auto Filtered Data to New File

[Jim May]

Often I will engage Auto-Filter on a Data Table, and once I've filtered on
it
I want to Create a New File to contain only the Current displayed Rows
(Visible Only);
The below code is not acheiving, new file is created but contains all rows
from original.
What am I missing here?
TIA,

Sub CopySheetToNewFile()
Dim NameOfSheet As String
NameOfSheet = ActiveSheet.Name
Selection.SpecialCells(xlCellTypeVisible).Select
Worksheets(NameOfSheet).Copy
ChDir "C:\My Documents\Excel Formulas\SheetNamesToFiles\"
ActiveWorkbook.SaveAs Filename:=NameOfSheet & ".xls"
ChDir "C:\My Documents\"
End Sub

 

[JulieD]

Hi Jim

on a quick read through the code i'ld start off by changing

Worksheets(NameOfSheet).Copy
to
Selection.Copy

Cheers
JulieD

 

[N10]

Often I will engage Auto-Filter on a Data Table, and once I've filtered on
it
I want to Create a New File to contain only the Current displayed Rows
(Visible Only);
The below code is not acheiving, new file is created but contains all rows
from original.
What am I missing here?
TIA,

Sub CopySheetToNewFile()
Dim NameOfSheet As String
NameOfSheet = ActiveSheet.Name
Selection.SpecialCells(xlCellTypeVisible).Select
Worksheets(NameOfSheet).Copy
ChDir "C:\My Documents\Excel Formulas\SheetNamesToFiles\"
ActiveWorkbook.SaveAs Filename:=NameOfSheet & ".xls"
ChDir "C:\My Documents\"
End Sub

hi jIM

To me it looks like that all this code will do is.

A) Change the name of the active worksheet
b) Save the current worbook with a new name

Nothing is being copied to a new destination

It appears your you need to add a new work book to copy data to

workbooks.add etc etc

Select data on your first sheet

The line > Selection.SpecialCells(xlCellTypeVisible).Select < infers
something has to been selected but in your code
nothing has been selected

Copy that data with the xlCellTypeVisible command to the new work book and
then save the new work book

If you are uncertain try running it with some dummy files in recorder mode
here is an example ;


Sub COPYTONEWBOOK()
'
'
' CREATES A COPY OF VISIBLE CELLS IN A NEW WORKBOOK AND SAVES IT

Workbooks.Add
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="C:\MYBOOK2.xls", FileFormat:=xlNormal,
_
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveSheet.Next.Select
Windows("MYBook1.xls").Activate
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows("MYBOOK2.xls").Activate
ActiveSheet.Paste
Range("A2").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close


End Sub


Hope this helps

N10

 

[Debra Dalgleish]

The following code will copy data from the active sheet to a new
workbook. If the table is filtered, only the visible rows will be
copied, and pasted as values.

'=========================
Sub CopySheetToNewFile()
Dim wb As Workbook
Dim ws As Worksheet
Dim strPath As String
Set ws = ActiveSheet
Set wb = Workbooks.Add
strPath = "C:\My Documents\Excel Formulas\SheetNamesToFiles\"

ws.Range("A1").CurrentRegion.Copy _
Destination:=wb.Sheets(1).Cells(1, 1)
wb.SaveAs Filename:=strPath & ws.Name & ".xls"

End Sub
'==========================

 

[Jim May]

My present code is:

Sub CopyFilteredDataToNewFile()
Dim rng As Range
Dim NameOfSheet As String
NameOfSheet = ActiveSheet.Name
Set rng = ActiveSheet.AutoFilter.Range
rng.Copy

Destination:=Worksheets("Sheet2").Range("A1") ' this code off google

But I wish to replace

with Destination per

below, something like

ChDir "C:\My Documents\Excel Formulas\SheetNamesToFiles\"
ActiveWorkbook.SaveAs Filename:=NameOfSheet & ".xls"
ChDir "C:\My Documents\"
End Sub

Can someone assist in organizing correct code?
TIA
Jim May

 

[JulieD]

Hi Jim

How did you go with Debra Dalgleish's solution?

Regards
JulieD

 

[Jim May]

Hold Off on getting into the above post -- I sent it before noticing that
you Debra and you, N10 had each sent me something; I'm jumping on your info
now -- so hold off on getting into my last post; what you both have sent
looks plenty "worth-while". Thanks to each of you.

 

[Jim May]

Debra:

Quick response,, Nothing is being copied into my new workbook file that
bears the
name of my original file activesheetname. Any thoughts?

Jim

 

[Debra Dalgleish]

The data should be copied to sheet1 of the new workbook, which is saved
with the name of the original sheet.

If you want sheet1 to have the same sheet name as the original, you can
add a line to the code:

'================
Sub CopySheetToNewFile()
Dim wb As Workbook
Dim ws As Worksheet
Dim strPath As String
Set ws = ActiveSheet
Set wb = Workbooks.Add
strPath = "C:\My Documents\Excel Formulas\SheetNamesToFiles\"

ws.Range("A1").CurrentRegion.Copy _
Destination:=wb.Sheets(1).Cells(1, 1)
wb.Sheets(1).Name = ws.Name 'name sheet in new workbook
wb.SaveAs Filename:=strPath & ws.Name & ".xls"

End Sub
'=====================

 

[Jim May]

Debra:
Got It !!
My Filtered Table was not at Range("A1"), as assumed, but rather at
A816 -- so I Changed:

ws.Range("A1").CurrentRegion.Copy

to

ws.AutoFilter.Range.Copy

That took care of it;
Much appreciate you patience;

 

[Debra Dalgleish]

Excellent! Thanks for letting me know.

Debra:
Got It !!
My Filtered Table was not at Range("A1"), as assumed, but rather at
A816 -- so I Changed:

ws.Range("A1").CurrentRegion.Copy

to

ws.AutoFilter.Range.Copy

That took care of it;
Much appreciate you patience;