Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 29
Default Paste Filtered Range to New Workbook- AS

Hello,

I recorded a macro and additionally used the DG help to construct the
following macro; however, I'm not certain how to copy the filtered range
(which will vary every time the worksheet is used) or how to find the last
row of the workbook to which the data will be pasted. Any help would be
great! And thanks in advance.

Sub Macro1()
Dim wbname As String
Dim copyrange As Range
Dim LastRow As Range
Dim rng As Range

' Macro1 Macro
' Macro recorded 12/8/2009 by asagay
'
wbname = ActiveSheet.Range("g1").Value & ActiveSheet.Range("j1").Value
Columns("A:F").Select
Range("F1").Activate
Selection.EntireColumn.Hidden = False
Rows("113:113").Select
Selection.AutoFilter Field:=1, Criteria1:=ActiveSheet.Range("j1").Value
Set rng = ActiveSheet.AutoFilter.Range
If rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Set copyrange = Rows("2:" & LastRow)
copyrange.Copy
End If
Workbooks.Open ("C:\Documents and
Settings\asagay\Desktop\Assays\BCA\BCASummary.xls" )
Windows("BCASummary.xls").Activate
ActiveSheet.Columns(1).SpecialCells (xlCellTypeLastCell)
ActiveSheet.Paste
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A17").Select
ActiveWorkbook.Save
ActiveWindow.Close
Columns("A:E").Select
Range("E1").Activate
Selection.EntireColumn.Hidden = True
ActiveSheet.ShowAllData
ChDir "C:\Documents and Settings\asagay\Desktop\Assays\BCA"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\asagay\Desktop\Assays\BCA\" & wbname,
FileFormat _
:=xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False
Workbooks.Open ("C:\Documents and
Settings\asagay\Desktop\Assays\BCA\BCASummary.xls" )
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 22,906
Default Paste Filtered Range to New Workbook- AS

See how Ron de Bruin does it.

All code provided.

http://www.rondebruin.nl/copy5.htm


Gord Dibben MS Excel MVP

On Wed, 9 Dec 2009 14:33:22 -0800, andiam24
wrote:

Hello,

I recorded a macro and additionally used the DG help to construct the
following macro; however, I'm not certain how to copy the filtered range
(which will vary every time the worksheet is used) or how to find the last
row of the workbook to which the data will be pasted. Any help would be
great! And thanks in advance.

Sub Macro1()
Dim wbname As String
Dim copyrange As Range
Dim LastRow As Range
Dim rng As Range

' Macro1 Macro
' Macro recorded 12/8/2009 by asagay
'
wbname = ActiveSheet.Range("g1").Value & ActiveSheet.Range("j1").Value
Columns("A:F").Select
Range("F1").Activate
Selection.EntireColumn.Hidden = False
Rows("113:113").Select
Selection.AutoFilter Field:=1, Criteria1:=ActiveSheet.Range("j1").Value
Set rng = ActiveSheet.AutoFilter.Range
If rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Set copyrange = Rows("2:" & LastRow)
copyrange.Copy
End If
Workbooks.Open ("C:\Documents and
Settings\asagay\Desktop\Assays\BCA\BCASummary.xls ")
Windows("BCASummary.xls").Activate
ActiveSheet.Columns(1).SpecialCells (xlCellTypeLastCell)
ActiveSheet.Paste
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A17").Select
ActiveWorkbook.Save
ActiveWindow.Close
Columns("A:E").Select
Range("E1").Activate
Selection.EntireColumn.Hidden = True
ActiveSheet.ShowAllData
ChDir "C:\Documents and Settings\asagay\Desktop\Assays\BCA"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\asagay\Desktop\Assays\BCA\" & wbname,
FileFormat _
:=xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False
Workbooks.Open ("C:\Documents and
Settings\asagay\Desktop\Assays\BCA\BCASummary.xls ")
ActiveWorkbook.Save
ActiveWindow.Close
End Sub


  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 35,218
Default Paste Filtered Range to New Workbook- AS

Untested, but it did compile.

I tried to include comments so that you could change the code to what you
needed. It's sometimes difficult to determine.

Anyway...

Option Explicit
Sub Macro1()

Dim wkbkName As String
Dim wkbk As Workbook

Dim LastRow As Range

Dim rng As Range
Dim VisRng As Range

Dim SummWkbkName As String
Dim SummWkbk As Workbook

Dim NextCell As Range
Dim myPath As String

myPath = "C:\Documents and Settings\asagay\Desktop\Assays\BCA\"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

SummWkbkName = myPath & "BCASummary.xls"

With ActiveSheet
wkbkName = .Range("g1").Value & .Range("j1").Value
'unhide the columns
.UsedRange.Columns.Hidden = False
'remove any existing autofilter arrows
.AutoFilterMode = False

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'filter columns A:J headers in row 1
'lastrow determined by data in column A
.Range("A1:J" & LastRow).AutoFilter _
Field:=1, Criteria1:=.Range("j1").Value

Set rng = .AutoFilter.Range

If rng.Columns(1).SpecialCells(xlVisible).Count = 1 Then
MsgBox "No visible rows except the header--no copy|paste done!"
Else
'reduce the number of rows by 1 to avoid the header
'with .resize(.rows-1)
'and avoid the header with .offset(1,0)
'avoid the headers (.offset(1,0)
Set VisRng = rng.Resize(rng.Rows - 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)

Set SummWkbk = Workbooks.Open(Filename:=SummWkbkName)

'change the name of the sheet here!
With SummWkbk.Worksheets("Sheet1")
Set NextCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

VisRng.Copy _
Destination:=NextCell

'I'm not sure what you're doing here
NextCell.Resize(VisRng.Columns(1).Cells.Count, _
VisRng.Rows(1).Cells.Count) _
.Cells.SpecialCells(xlCellTypeBlanks).Delete shift:=xlToLeft

SummWkbk.Close savechanges:=True

.Range("e:e").Hidden = True

.ShowAllData

'the parent of the activesheet is the activeworkbook
.Parent.SaveAs _
Filename:=myPath & wkbkName, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False

'why open this bcasummary.xls file again?
'It was just modified and saved?
End If
End With

End Sub


andiam24 wrote:

Hello,

I recorded a macro and additionally used the DG help to construct the
following macro; however, I'm not certain how to copy the filtered range
(which will vary every time the worksheet is used) or how to find the last
row of the workbook to which the data will be pasted. Any help would be
great! And thanks in advance.

Sub Macro1()
Dim wbname As String
Dim copyrange As Range
Dim LastRow As Range
Dim rng As Range

' Macro1 Macro
' Macro recorded 12/8/2009 by asagay
'
wbname = ActiveSheet.Range("g1").Value & ActiveSheet.Range("j1").Value
Columns("A:F").Select
Range("F1").Activate
Selection.EntireColumn.Hidden = False
Rows("113:113").Select
Selection.AutoFilter Field:=1, Criteria1:=ActiveSheet.Range("j1").Value
Set rng = ActiveSheet.AutoFilter.Range
If rng.Columns(1).SpecialCells(xlVisible).Count 1 Then
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Set copyrange = Rows("2:" & LastRow)
copyrange.Copy
End If
Workbooks.Open ("C:\Documents and
Settings\asagay\Desktop\Assays\BCA\BCASummary.xls" )
Windows("BCASummary.xls").Activate
ActiveSheet.Columns(1).SpecialCells (xlCellTypeLastCell)
ActiveSheet.Paste
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A17").Select
ActiveWorkbook.Save
ActiveWindow.Close
Columns("A:E").Select
Range("E1").Activate
Selection.EntireColumn.Hidden = True
ActiveSheet.ShowAllData
ChDir "C:\Documents and Settings\asagay\Desktop\Assays\BCA"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\asagay\Desktop\Assays\BCA\" & wbname,
FileFormat _
:=xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False
Workbooks.Open ("C:\Documents and
Settings\asagay\Desktop\Assays\BCA\BCASummary.xls" )
ActiveWorkbook.Save
ActiveWindow.Close
End Sub


--

Dave Peterson
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Filtered copy and paste error Bagia Excel Discussion (Misc queries) 1 October 21st 09 04:34 PM
copy and paste filtered data Churley Excel Discussion (Misc queries) 6 September 4th 07 04:17 PM
cut and paste filtered items ferde Excel Discussion (Misc queries) 1 December 6th 05 03:41 PM
Paste range of values into filtered sheet ken2005 Excel Discussion (Misc queries) 3 October 3rd 05 11:22 AM
paste over a filtered range freddie2711 Excel Discussion (Misc queries) 8 April 27th 05 01:20 PM


All times are GMT +1. The time now is 08:50 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"