Hi,

I'm want to autofilter in "Master.xls" sheet1 and paste the results to the
bottom of existing "Current.xls" sheet1. I found a macro by Ron de Bruin
that works if pasting to a worksheet in the same workbook. I tried to modify
it but have not had any luck.


Dim My_Range As Range
Dim DestSh As Worksheet
Dim CalcMode As Long
Dim ViewMode As Long
Dim FilterCriteria As String
Dim CCount As Long
Dim rng As Range

'set filter ranger on Sheet 1 of Master.xls
Windows("Master.xls").Activate
Set My_Range = Worksheets("sheet1").Range("A2:H" &
LastRow(Worksheets("Sheet1")))
My_Range.Parent.Select

'set the destination worksheet. This is where it bombs!

Set DestSh = Worksheets("[Current.xls]sheet1")

'change ScreenUpdating, Calculation, EnableEvents,...

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False

End With
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False

'Firstly, remove the Autofilter

My_Range.Parent.AutoFilterMode = False


'Filter and set the filter field and filter criteria:

My_Range.AutoFilter Field:=1, Criteria1:="=3015"

'Check if there are not more then 8192 areas (limit of areas that Excel
can copy)

CCount = 0
On Error Resume Next
CCount =
My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
On Error GoTo 0
If CCount = 0 Then
MsgBox "There are more than 8192 areas:" _
& vbNewLine & "It is not possible to copy the visible data." _
& vbNewLine & "Tip:Sort your data before you use this macro.", _
vbOKOnly, "Copy to worksheet"
Else
'Copy the visible data and use PasteSpecial to paste to the Desth

With My_Range.Parent.AutoFilter.Range
On Error Resume Next
'Set rng to the visible cells in My_Range without the header row
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
'copy and paste the cells into Destsh below the existing data
rng.Copy
With DestSh.Range("A" & LastRow(DestSh) + 1)
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False

End With
End If
End With
End If

'close autofilter

My_Range.Parent.AutoFilterMode = False

'Restore screenupdating, calculation, enableevents...

ActiveWindow.View = ViewMode
Application.Goto DestSh.Range("a2")

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode

End With

End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(what:="*", _
After:=sh.Range("a2"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
--
Thank you!!

Mountaineer

> Set DestSh = Worksheets("[Current.xls]sheet1")

Set DestSh = Workbooks("Current").Worksheets("sheet1")

regards
r



Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/...ternative.html


"Mountaineer" wrote:

> Hi,
>
> I'm want to autofilter in "Master.xls" sheet1 and paste the results to the
> bottom of existing "Current.xls" sheet1. I found a macro by Ron de Bruin
> that works if pasting to a worksheet in the same workbook. I tried to modify
> it but have not had any luck.
>
>
> Dim My_Range As Range
> Dim DestSh As Worksheet
> Dim CalcMode As Long
> Dim ViewMode As Long
> Dim FilterCriteria As String
> Dim CCount As Long
> Dim rng As Range
>
> 'set filter ranger on Sheet 1 of Master.xls
> Windows("Master.xls").Activate
> Set My_Range = Worksheets("sheet1").Range("A2:H" &
> LastRow(Worksheets("Sheet1")))
> My_Range.Parent.Select
>
> 'set the destination worksheet. This is where it bombs!
>
> Set DestSh = Worksheets("[Current.xls]sheet1")
>
> 'change ScreenUpdating, Calculation, EnableEvents,...
>
> With Application
> CalcMode = .Calculation
> .Calculation = xlCalculationManual
> .ScreenUpdating = False
> .EnableEvents = False
>
> End With
> ViewMode = ActiveWindow.View
> ActiveWindow.View = xlNormalView
> ActiveSheet.DisplayPageBreaks = False
>
> 'Firstly, remove the Autofilter
>
> My_Range.Parent.AutoFilterMode = False
>
>
> 'Filter and set the filter field and filter criteria:
>
> My_Range.AutoFilter Field:=1, Criteria1:="=3015"
>
> 'Check if there are not more then 8192 areas (limit of areas that Excel
> can copy)
>
> CCount = 0
> On Error Resume Next
> CCount =
> My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
> On Error GoTo 0
> If CCount = 0 Then
> MsgBox "There are more than 8192 areas:" _
> & vbNewLine & "It is not possible to copy the visible data." _
> & vbNewLine & "Tip:Sort your data before you use this macro.", _
> vbOKOnly, "Copy to worksheet"
> Else
> 'Copy the visible data and use PasteSpecial to paste to the Desth
>
> With My_Range.Parent.AutoFilter.Range
> On Error Resume Next
> 'Set rng to the visible cells in My_Range without the header row
> Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
> .SpecialCells(xlCellTypeVisible)
> On Error GoTo 0
> If Not rng Is Nothing Then
> 'copy and paste the cells into Destsh below the existing data
> rng.Copy
> With DestSh.Range("A" & LastRow(DestSh) + 1)
> .PasteSpecial Paste:=8
> .PasteSpecial xlPasteValues
> .PasteSpecial xlPasteFormats
> Application.CutCopyMode = False
>
> End With
> End If
> End With
> End If
>
> 'close autofilter
>
> My_Range.Parent.AutoFilterMode = False
>
> 'Restore screenupdating, calculation, enableevents...
>
> ActiveWindow.View = ViewMode
> Application.Goto DestSh.Range("a2")
>
> With Application
> .ScreenUpdating = True
> .EnableEvents = True
> .Calculation = CalcMode
>
> End With
>
> End Sub
>
> Function LastRow(sh As Worksheet)
> On Error Resume Next
> LastRow = sh.Cells.Find(what:="*", _
> After:=sh.Range("a2"), _
> Lookat:=xlPart, _
> LookIn:=xlValues, _
> SearchOrder:=xlByRows, _
> SearchDirection:=xlPrevious, _
> MatchCase:=False).Row
> On Error GoTo 0
> End Function
> --
> Thank you!!
>
> Mountaineer

Thank you for such a quick response.

I now get a compile error:Sub or Function not defined. "Wookbooks" gets
highlighted.
--
Thank you!!

Mountaineer


"r" wrote:

> > Set DestSh = Worksheets("[Current.xls]sheet1")
>
> Set DestSh = Workbooks("Current").Worksheets("sheet1")
>
> regards
> r
>
>
>
> Il mio ultimo lavoro ...
> http://excelvba.altervista.org/blog/...ternative.html
>
>
> "Mountaineer" wrote:
>
> > Hi,
> >
> > I'm want to autofilter in "Master.xls" sheet1 and paste the results to the
> > bottom of existing "Current.xls" sheet1. I found a macro by Ron de Bruin
> > that works if pasting to a worksheet in the same workbook. I tried to modify
> > it but have not had any luck.
> >
> >
> > Dim My_Range As Range
> > Dim DestSh As Worksheet
> > Dim CalcMode As Long
> > Dim ViewMode As Long
> > Dim FilterCriteria As String
> > Dim CCount As Long
> > Dim rng As Range
> >
> > 'set filter ranger on Sheet 1 of Master.xls
> > Windows("Master.xls").Activate
> > Set My_Range = Worksheets("sheet1").Range("A2:H" &
> > LastRow(Worksheets("Sheet1")))
> > My_Range.Parent.Select
> >
> > 'set the destination worksheet. This is where it bombs!
> >
> > Set DestSh = Worksheets("[Current.xls]sheet1")
> >
> > 'change ScreenUpdating, Calculation, EnableEvents,...
> >
> > With Application
> > CalcMode = .Calculation
> > .Calculation = xlCalculationManual
> > .ScreenUpdating = False
> > .EnableEvents = False
> >
> > End With
> > ViewMode = ActiveWindow.View
> > ActiveWindow.View = xlNormalView
> > ActiveSheet.DisplayPageBreaks = False
> >
> > 'Firstly, remove the Autofilter
> >
> > My_Range.Parent.AutoFilterMode = False
> >
> >
> > 'Filter and set the filter field and filter criteria:
> >
> > My_Range.AutoFilter Field:=1, Criteria1:="=3015"
> >
> > 'Check if there are not more then 8192 areas (limit of areas that Excel
> > can copy)
> >
> > CCount = 0
> > On Error Resume Next
> > CCount =
> > My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
> > On Error GoTo 0
> > If CCount = 0 Then
> > MsgBox "There are more than 8192 areas:" _
> > & vbNewLine & "It is not possible to copy the visible data." _
> > & vbNewLine & "Tip:Sort your data before you use this macro.", _
> > vbOKOnly, "Copy to worksheet"
> > Else
> > 'Copy the visible data and use PasteSpecial to paste to the Desth
> >
> > With My_Range.Parent.AutoFilter.Range
> > On Error Resume Next
> > 'Set rng to the visible cells in My_Range without the header row
> > Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
> > .SpecialCells(xlCellTypeVisible)
> > On Error GoTo 0
> > If Not rng Is Nothing Then
> > 'copy and paste the cells into Destsh below the existing data
> > rng.Copy
> > With DestSh.Range("A" & LastRow(DestSh) + 1)
> > .PasteSpecial Paste:=8
> > .PasteSpecial xlPasteValues
> > .PasteSpecial xlPasteFormats
> > Application.CutCopyMode = False
> >
> > End With
> > End If
> > End With
> > End If
> >
> > 'close autofilter
> >
> > My_Range.Parent.AutoFilterMode = False
> >
> > 'Restore screenupdating, calculation, enableevents...
> >
> > ActiveWindow.View = ViewMode
> > Application.Goto DestSh.Range("a2")
> >
> > With Application
> > .ScreenUpdating = True
> > .EnableEvents = True
> > .Calculation = CalcMode
> >
> > End With
> >
> > End Sub
> >
> > Function LastRow(sh As Worksheet)
> > On Error Resume Next
> > LastRow = sh.Cells.Find(what:="*", _
> > After:=sh.Range("a2"), _
> > Lookat:=xlPart, _
> > LookIn:=xlValues, _
> > SearchOrder:=xlByRows, _
> > SearchDirection:=xlPrevious, _
> > MatchCase:=False).Row
> > On Error GoTo 0
> > End Function
> > --
> > Thank you!!
> >
> > Mountaineer

Workbooks

regards
r

Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/...ternative.html


"Mountaineer" wrote:

> Thank you for such a quick response.
>
> I now get a compile error:Sub or Function not defined. "Wookbooks" gets
> highlighted.
> --
> Thank you!!
>
> Mountaineer
>
>
> "r" wrote:
>
> > > Set DestSh = Worksheets("[Current.xls]sheet1")
> >
> > Set DestSh = Workbooks("Current").Worksheets("sheet1")
> >
> > regards
> > r
> >
> >
> >
> > Il mio ultimo lavoro ...
> > http://excelvba.altervista.org/blog/...ternative.html
> >
> >
> > "Mountaineer" wrote:
> >
> > > Hi,
> > >
> > > I'm want to autofilter in "Master.xls" sheet1 and paste the results to the
> > > bottom of existing "Current.xls" sheet1. I found a macro by Ron de Bruin
> > > that works if pasting to a worksheet in the same workbook. I tried to modify
> > > it but have not had any luck.
> > >
> > >
> > > Dim My_Range As Range
> > > Dim DestSh As Worksheet
> > > Dim CalcMode As Long
> > > Dim ViewMode As Long
> > > Dim FilterCriteria As String
> > > Dim CCount As Long
> > > Dim rng As Range
> > >
> > > 'set filter ranger on Sheet 1 of Master.xls
> > > Windows("Master.xls").Activate
> > > Set My_Range = Worksheets("sheet1").Range("A2:H" &
> > > LastRow(Worksheets("Sheet1")))
> > > My_Range.Parent.Select
> > >
> > > 'set the destination worksheet. This is where it bombs!
> > >
> > > Set DestSh = Worksheets("[Current.xls]sheet1")
> > >
> > > 'change ScreenUpdating, Calculation, EnableEvents,...
> > >
> > > With Application
> > > CalcMode = .Calculation
> > > .Calculation = xlCalculationManual
> > > .ScreenUpdating = False
> > > .EnableEvents = False
> > >
> > > End With
> > > ViewMode = ActiveWindow.View
> > > ActiveWindow.View = xlNormalView
> > > ActiveSheet.DisplayPageBreaks = False
> > >
> > > 'Firstly, remove the Autofilter
> > >
> > > My_Range.Parent.AutoFilterMode = False
> > >
> > >
> > > 'Filter and set the filter field and filter criteria:
> > >
> > > My_Range.AutoFilter Field:=1, Criteria1:="=3015"
> > >
> > > 'Check if there are not more then 8192 areas (limit of areas that Excel
> > > can copy)
> > >
> > > CCount = 0
> > > On Error Resume Next
> > > CCount =
> > > My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
> > > On Error GoTo 0
> > > If CCount = 0 Then
> > > MsgBox "There are more than 8192 areas:" _
> > > & vbNewLine & "It is not possible to copy the visible data." _
> > > & vbNewLine & "Tip:Sort your data before you use this macro.", _
> > > vbOKOnly, "Copy to worksheet"
> > > Else
> > > 'Copy the visible data and use PasteSpecial to paste to the Desth
> > >
> > > With My_Range.Parent.AutoFilter.Range
> > > On Error Resume Next
> > > 'Set rng to the visible cells in My_Range without the header row
> > > Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
> > > .SpecialCells(xlCellTypeVisible)
> > > On Error GoTo 0
> > > If Not rng Is Nothing Then
> > > 'copy and paste the cells into Destsh below the existing data
> > > rng.Copy
> > > With DestSh.Range("A" & LastRow(DestSh) + 1)
> > > .PasteSpecial Paste:=8
> > > .PasteSpecial xlPasteValues
> > > .PasteSpecial xlPasteFormats
> > > Application.CutCopyMode = False
> > >
> > > End With
> > > End If
> > > End With
> > > End If
> > >
> > > 'close autofilter
> > >
> > > My_Range.Parent.AutoFilterMode = False
> > >
> > > 'Restore screenupdating, calculation, enableevents...
> > >
> > > ActiveWindow.View = ViewMode
> > > Application.Goto DestSh.Range("a2")
> > >
> > > With Application
> > > .ScreenUpdating = True
> > > .EnableEvents = True
> > > .Calculation = CalcMode
> > >
> > > End With
> > >
> > > End Sub
> > >
> > > Function LastRow(sh As Worksheet)
> > > On Error Resume Next
> > > LastRow = sh.Cells.Find(what:="*", _
> > > After:=sh.Range("a2"), _
> > > Lookat:=xlPart, _
> > > LookIn:=xlValues, _
> > > SearchOrder:=xlByRows, _
> > > SearchDirection:=xlPrevious, _
> > > MatchCase:=False).Row
> > > On Error GoTo 0
> > > End Function
> > > --
> > > Thank you!!
> > >
> > > Mountaineer

I am so embarrassed. I fixed my misspelling. Now I get "subscript out of
range" still at the same place "Set Destsh...."

Thank you for your patience.


--
Thank you!!

Mountaineer


"r" wrote:

> Workbooks
>
> regards
> r
>
> Il mio ultimo lavoro ...
> http://excelvba.altervista.org/blog/...ternative.html
>
>
> "Mountaineer" wrote:
>
> > Thank you for such a quick response.
> >
> > I now get a compile error:Sub or Function not defined. "Wookbooks" gets
> > highlighted.
> > --
> > Thank you!!
> >
> > Mountaineer
> >
> >
> > "r" wrote:
> >
> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
> > >
> > > Set DestSh = Workbooks("Current").Worksheets("sheet1")
> > >
> > > regards
> > > r
> > >
> > >
> > >
> > > Il mio ultimo lavoro ...
> > > http://excelvba.altervista.org/blog/...ternative.html
> > >
> > >
> > > "Mountaineer" wrote:
> > >
> > > > Hi,
> > > >
> > > > I'm want to autofilter in "Master.xls" sheet1 and paste the results to the
> > > > bottom of existing "Current.xls" sheet1. I found a macro by Ron de Bruin
> > > > that works if pasting to a worksheet in the same workbook. I tried to modify
> > > > it but have not had any luck.
> > > >
> > > >
> > > > Dim My_Range As Range
> > > > Dim DestSh As Worksheet
> > > > Dim CalcMode As Long
> > > > Dim ViewMode As Long
> > > > Dim FilterCriteria As String
> > > > Dim CCount As Long
> > > > Dim rng As Range
> > > >
> > > > 'set filter ranger on Sheet 1 of Master.xls
> > > > Windows("Master.xls").Activate
> > > > Set My_Range = Worksheets("sheet1").Range("A2:H" &
> > > > LastRow(Worksheets("Sheet1")))
> > > > My_Range.Parent.Select
> > > >
> > > > 'set the destination worksheet. This is where it bombs!
> > > >
> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
> > > >
> > > > 'change ScreenUpdating, Calculation, EnableEvents,...
> > > >
> > > > With Application
> > > > CalcMode = .Calculation
> > > > .Calculation = xlCalculationManual
> > > > .ScreenUpdating = False
> > > > .EnableEvents = False
> > > >
> > > > End With
> > > > ViewMode = ActiveWindow.View
> > > > ActiveWindow.View = xlNormalView
> > > > ActiveSheet.DisplayPageBreaks = False
> > > >
> > > > 'Firstly, remove the Autofilter
> > > >
> > > > My_Range.Parent.AutoFilterMode = False
> > > >
> > > >
> > > > 'Filter and set the filter field and filter criteria:
> > > >
> > > > My_Range.AutoFilter Field:=1, Criteria1:="=3015"
> > > >
> > > > 'Check if there are not more then 8192 areas (limit of areas that Excel
> > > > can copy)
> > > >
> > > > CCount = 0
> > > > On Error Resume Next
> > > > CCount =
> > > > My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
> > > > On Error GoTo 0
> > > > If CCount = 0 Then
> > > > MsgBox "There are more than 8192 areas:" _
> > > > & vbNewLine & "It is not possible to copy the visible data." _
> > > > & vbNewLine & "Tip:Sort your data before you use this macro.", _
> > > > vbOKOnly, "Copy to worksheet"
> > > > Else
> > > > 'Copy the visible data and use PasteSpecial to paste to the Desth
> > > >
> > > > With My_Range.Parent.AutoFilter.Range
> > > > On Error Resume Next
> > > > 'Set rng to the visible cells in My_Range without the header row
> > > > Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
> > > > .SpecialCells(xlCellTypeVisible)
> > > > On Error GoTo 0
> > > > If Not rng Is Nothing Then
> > > > 'copy and paste the cells into Destsh below the existing data
> > > > rng.Copy
> > > > With DestSh.Range("A" & LastRow(DestSh) + 1)
> > > > .PasteSpecial Paste:=8
> > > > .PasteSpecial xlPasteValues
> > > > .PasteSpecial xlPasteFormats
> > > > Application.CutCopyMode = False
> > > >
> > > > End With
> > > > End If
> > > > End With
> > > > End If
> > > >
> > > > 'close autofilter
> > > >
> > > > My_Range.Parent.AutoFilterMode = False
> > > >
> > > > 'Restore screenupdating, calculation, enableevents...
> > > >
> > > > ActiveWindow.View = ViewMode
> > > > Application.Goto DestSh.Range("a2")
> > > >
> > > > With Application
> > > > .ScreenUpdating = True
> > > > .EnableEvents = True
> > > > .Calculation = CalcMode
> > > >
> > > > End With
> > > >
> > > > End Sub
> > > >
> > > > Function LastRow(sh As Worksheet)
> > > > On Error Resume Next
> > > > LastRow = sh.Cells.Find(what:="*", _
> > > > After:=sh.Range("a2"), _
> > > > Lookat:=xlPart, _
> > > > LookIn:=xlValues, _
> > > > SearchOrder:=xlByRows, _
> > > > SearchDirection:=xlPrevious, _
> > > > MatchCase:=False).Row
> > > > On Error GoTo 0
> > > > End Function
> > > > --
> > > > Thank you!!
> > > >
> > > > Mountaineer

make sure that the name of the destination workbook and worksheet are
correct and that it is open

"Mountaineer" <(E-Mail Removed)> wrote in message
news:73FD4104-C507-43EF-A7DE-(E-Mail Removed)...
> I am so embarrassed. I fixed my misspelling. Now I get "subscript out of
> range" still at the same place "Set Destsh...."
>
> Thank you for your patience.
>
>
> --
> Thank you!!
>
> Mountaineer
>
>
> "r" wrote:
>
>> Workbooks
>>
>> regards
>> r
>>
>> Il mio ultimo lavoro ...
>> http://excelvba.altervista.org/blog/...ternative.html
>>
>>
>> "Mountaineer" wrote:
>>
>> > Thank you for such a quick response.
>> >
>> > I now get a compile error:Sub or Function not defined. "Wookbooks"
>> > gets
>> > highlighted.
>> > --
>> > Thank you!!
>> >
>> > Mountaineer
>> >
>> >
>> > "r" wrote:
>> >
>> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
>> > >
>> > > Set DestSh = Workbooks("Current").Worksheets("sheet1")
>> > >
>> > > regards
>> > > r
>> > >
>> > >
>> > >
>> > > Il mio ultimo lavoro ...
>> > > http://excelvba.altervista.org/blog/...ternative.html
>> > >
>> > >
>> > > "Mountaineer" wrote:
>> > >
>> > > > Hi,
>> > > >
>> > > > I'm want to autofilter in "Master.xls" sheet1 and paste the results
>> > > > to the
>> > > > bottom of existing "Current.xls" sheet1. I found a macro by Ron de
>> > > > Bruin
>> > > > that works if pasting to a worksheet in the same workbook. I tried
>> > > > to modify
>> > > > it but have not had any luck.
>> > > >
>> > > >
>> > > > Dim My_Range As Range
>> > > > Dim DestSh As Worksheet
>> > > > Dim CalcMode As Long
>> > > > Dim ViewMode As Long
>> > > > Dim FilterCriteria As String
>> > > > Dim CCount As Long
>> > > > Dim rng As Range
>> > > >
>> > > > 'set filter ranger on Sheet 1 of Master.xls
>> > > > Windows("Master.xls").Activate
>> > > > Set My_Range = Worksheets("sheet1").Range("A2:H" &
>> > > > LastRow(Worksheets("Sheet1")))
>> > > > My_Range.Parent.Select
>> > > >
>> > > > 'set the destination worksheet. This is where it bombs!
>> > > >
>> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
>> > > >
>> > > > 'change ScreenUpdating, Calculation, EnableEvents,...
>> > > >
>> > > > With Application
>> > > > CalcMode = .Calculation
>> > > > .Calculation = xlCalculationManual
>> > > > .ScreenUpdating = False
>> > > > .EnableEvents = False
>> > > >
>> > > > End With
>> > > > ViewMode = ActiveWindow.View
>> > > > ActiveWindow.View = xlNormalView
>> > > > ActiveSheet.DisplayPageBreaks = False
>> > > >
>> > > > 'Firstly, remove the Autofilter
>> > > >
>> > > > My_Range.Parent.AutoFilterMode = False
>> > > >
>> > > >
>> > > > 'Filter and set the filter field and filter criteria:
>> > > >
>> > > > My_Range.AutoFilter Field:=1, Criteria1:="=3015"
>> > > >
>> > > > 'Check if there are not more then 8192 areas (limit of areas
>> > > > that Excel
>> > > > can copy)
>> > > >
>> > > > CCount = 0
>> > > > On Error Resume Next
>> > > > CCount =
>> > > > My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
>> > > > On Error GoTo 0
>> > > > If CCount = 0 Then
>> > > > MsgBox "There are more than 8192 areas:" _
>> > > > & vbNewLine & "It is not possible to copy the visible
>> > > > data." _
>> > > > & vbNewLine & "Tip:Sort your data before you use this
>> > > > macro.", _
>> > > > vbOKOnly, "Copy to worksheet"
>> > > > Else
>> > > > 'Copy the visible data and use PasteSpecial to paste to the
>> > > > Desth
>> > > >
>> > > > With My_Range.Parent.AutoFilter.Range
>> > > > On Error Resume Next
>> > > > 'Set rng to the visible cells in My_Range without the header
>> > > > row
>> > > > Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
>> > > > _
>> > > > .SpecialCells(xlCellTypeVisible)
>> > > > On Error GoTo 0
>> > > > If Not rng Is Nothing Then
>> > > > 'copy and paste the cells into Destsh below the existing data
>> > > > rng.Copy
>> > > > With DestSh.Range("A" & LastRow(DestSh) + 1)
>> > > > .PasteSpecial Paste:=8
>> > > > .PasteSpecial xlPasteValues
>> > > > .PasteSpecial xlPasteFormats
>> > > > Application.CutCopyMode = False
>> > > >
>> > > > End With
>> > > > End If
>> > > > End With
>> > > > End If
>> > > >
>> > > > 'close autofilter
>> > > >
>> > > > My_Range.Parent.AutoFilterMode = False
>> > > >
>> > > > 'Restore screenupdating, calculation, enableevents...
>> > > >
>> > > > ActiveWindow.View = ViewMode
>> > > > Application.Goto DestSh.Range("a2")
>> > > >
>> > > > With Application
>> > > > .ScreenUpdating = True
>> > > > .EnableEvents = True
>> > > > .Calculation = CalcMode
>> > > >
>> > > > End With
>> > > >
>> > > > End Sub
>> > > >
>> > > > Function LastRow(sh As Worksheet)
>> > > > On Error Resume Next
>> > > > LastRow = sh.Cells.Find(what:="*", _
>> > > > After:=sh.Range("a2"), _
>> > > > Lookat:=xlPart, _
>> > > > LookIn:=xlValues, _
>> > > > SearchOrder:=xlByRows, _
>> > > > SearchDirection:=xlPrevious, _
>> > > > MatchCase:=False).Row
>> > > > On Error GoTo 0
>> > > > End Function
>> > > > --
>> > > > Thank you!!
>> > > >
>> > > > Mountaineer

Hi,

I made sure both "Current" and "Master" spreadsheets are open. Below is a
"copy" since I don't trust my spelling. I am still getting the "Subscript
out of range" error. Is it possible it's because I don't have anything DIM
as a workbook?

thanks for your help.


Set DestSh = Workbooks("Current").Worksheets("Sheet1")
--
Thank you!!

Mountaineer


"Patrick Molloy" wrote:

> make sure that the name of the destination workbook and worksheet are
> correct and that it is open
>
> "Mountaineer" <(E-Mail Removed)> wrote in message
> news:73FD4104-C507-43EF-A7DE-(E-Mail Removed)...
> > I am so embarrassed. I fixed my misspelling. Now I get "subscript out of
> > range" still at the same place "Set Destsh...."
> >
> > Thank you for your patience.
> >
> >
> > --
> > Thank you!!
> >
> > Mountaineer
> >
> >
> > "r" wrote:
> >
> >> Workbooks
> >>
> >> regards
> >> r
> >>
> >> Il mio ultimo lavoro ...
> >> http://excelvba.altervista.org/blog/...ternative.html
> >>
> >>
> >> "Mountaineer" wrote:
> >>
> >> > Thank you for such a quick response.
> >> >
> >> > I now get a compile error:Sub or Function not defined. "Wookbooks"
> >> > gets
> >> > highlighted.
> >> > --
> >> > Thank you!!
> >> >
> >> > Mountaineer
> >> >
> >> >
> >> > "r" wrote:
> >> >
> >> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
> >> > >
> >> > > Set DestSh = Workbooks("Current").Worksheets("sheet1")
> >> > >
> >> > > regards
> >> > > r
> >> > >
> >> > >
> >> > >
> >> > > Il mio ultimo lavoro ...
> >> > > http://excelvba.altervista.org/blog/...ternative.html
> >> > >
> >> > >
> >> > > "Mountaineer" wrote:
> >> > >
> >> > > > Hi,
> >> > > >
> >> > > > I'm want to autofilter in "Master.xls" sheet1 and paste the results
> >> > > > to the
> >> > > > bottom of existing "Current.xls" sheet1. I found a macro by Ron de
> >> > > > Bruin
> >> > > > that works if pasting to a worksheet in the same workbook. I tried
> >> > > > to modify
> >> > > > it but have not had any luck.
> >> > > >
> >> > > >
> >> > > > Dim My_Range As Range
> >> > > > Dim DestSh As Worksheet
> >> > > > Dim CalcMode As Long
> >> > > > Dim ViewMode As Long
> >> > > > Dim FilterCriteria As String
> >> > > > Dim CCount As Long
> >> > > > Dim rng As Range
> >> > > >
> >> > > > 'set filter ranger on Sheet 1 of Master.xls
> >> > > > Windows("Master.xls").Activate
> >> > > > Set My_Range = Worksheets("sheet1").Range("A2:H" &
> >> > > > LastRow(Worksheets("Sheet1")))
> >> > > > My_Range.Parent.Select
> >> > > >
> >> > > > 'set the destination worksheet. This is where it bombs!
> >> > > >
> >> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
> >> > > >
> >> > > > 'change ScreenUpdating, Calculation, EnableEvents,...
> >> > > >
> >> > > > With Application
> >> > > > CalcMode = .Calculation
> >> > > > .Calculation = xlCalculationManual
> >> > > > .ScreenUpdating = False
> >> > > > .EnableEvents = False
> >> > > >
> >> > > > End With
> >> > > > ViewMode = ActiveWindow.View
> >> > > > ActiveWindow.View = xlNormalView
> >> > > > ActiveSheet.DisplayPageBreaks = False
> >> > > >
> >> > > > 'Firstly, remove the Autofilter
> >> > > >
> >> > > > My_Range.Parent.AutoFilterMode = False
> >> > > >
> >> > > >
> >> > > > 'Filter and set the filter field and filter criteria:
> >> > > >
> >> > > > My_Range.AutoFilter Field:=1, Criteria1:="=3015"
> >> > > >
> >> > > > 'Check if there are not more then 8192 areas (limit of areas
> >> > > > that Excel
> >> > > > can copy)
> >> > > >
> >> > > > CCount = 0
> >> > > > On Error Resume Next
> >> > > > CCount =
> >> > > > My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
> >> > > > On Error GoTo 0
> >> > > > If CCount = 0 Then
> >> > > > MsgBox "There are more than 8192 areas:" _
> >> > > > & vbNewLine & "It is not possible to copy the visible
> >> > > > data." _
> >> > > > & vbNewLine & "Tip:Sort your data before you use this
> >> > > > macro.", _
> >> > > > vbOKOnly, "Copy to worksheet"
> >> > > > Else
> >> > > > 'Copy the visible data and use PasteSpecial to paste to the
> >> > > > Desth
> >> > > >
> >> > > > With My_Range.Parent.AutoFilter.Range
> >> > > > On Error Resume Next
> >> > > > 'Set rng to the visible cells in My_Range without the header
> >> > > > row
> >> > > > Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
> >> > > > _
> >> > > > .SpecialCells(xlCellTypeVisible)
> >> > > > On Error GoTo 0
> >> > > > If Not rng Is Nothing Then
> >> > > > 'copy and paste the cells into Destsh below the existing data
> >> > > > rng.Copy
> >> > > > With DestSh.Range("A" & LastRow(DestSh) + 1)
> >> > > > .PasteSpecial Paste:=8
> >> > > > .PasteSpecial xlPasteValues
> >> > > > .PasteSpecial xlPasteFormats
> >> > > > Application.CutCopyMode = False
> >> > > >
> >> > > > End With
> >> > > > End If
> >> > > > End With
> >> > > > End If
> >> > > >
> >> > > > 'close autofilter
> >> > > >
> >> > > > My_Range.Parent.AutoFilterMode = False
> >> > > >
> >> > > > 'Restore screenupdating, calculation, enableevents...
> >> > > >
> >> > > > ActiveWindow.View = ViewMode
> >> > > > Application.Goto DestSh.Range("a2")
> >> > > >
> >> > > > With Application
> >> > > > .ScreenUpdating = True
> >> > > > .EnableEvents = True
> >> > > > .Calculation = CalcMode
> >> > > >
> >> > > > End With
> >> > > >
> >> > > > End Sub
> >> > > >
> >> > > > Function LastRow(sh As Worksheet)
> >> > > > On Error Resume Next
> >> > > > LastRow = sh.Cells.Find(what:="*", _
> >> > > > After:=sh.Range("a2"), _
> >> > > > Lookat:=xlPart, _
> >> > > > LookIn:=xlValues, _
> >> > > > SearchOrder:=xlByRows, _
> >> > > > SearchDirection:=xlPrevious, _
> >> > > > MatchCase:=False).Row
> >> > > > On Error GoTo 0
> >> > > > End Function
> >> > > > --
> >> > > > Thank you!!
> >> > > >
> >> > > > Mountaineer
>
>

probably needs the .xls extension

Set DestSh = Workbooks("Current.xls").Worksheets("Sheet1")




"Mountaineer" <(E-Mail Removed)> wrote in message
news:BA623DBA-ECD3-4FB1-A03C-(E-Mail Removed)...
> Hi,
>
> I made sure both "Current" and "Master" spreadsheets are open. Below is a
> "copy" since I don't trust my spelling. I am still getting the "Subscript
> out of range" error. Is it possible it's because I don't have anything
> DIM
> as a workbook?
>
> thanks for your help.
>
>
> Set DestSh = Workbooks("Current").Worksheets("Sheet1")
> --
> Thank you!!
>
> Mountaineer
>
>
> "Patrick Molloy" wrote:
>
>> make sure that the name of the destination workbook and worksheet are
>> correct and that it is open
>>
>> "Mountaineer" <(E-Mail Removed)> wrote in message
>> news:73FD4104-C507-43EF-A7DE-(E-Mail Removed)...
>> > I am so embarrassed. I fixed my misspelling. Now I get "subscript out
>> > of
>> > range" still at the same place "Set Destsh...."
>> >
>> > Thank you for your patience.
>> >
>> >
>> > --
>> > Thank you!!
>> >
>> > Mountaineer
>> >
>> >
>> > "r" wrote:
>> >
>> >> Workbooks
>> >>
>> >> regards
>> >> r
>> >>
>> >> Il mio ultimo lavoro ...
>> >> http://excelvba.altervista.org/blog/...ternative.html
>> >>
>> >>
>> >> "Mountaineer" wrote:
>> >>
>> >> > Thank you for such a quick response.
>> >> >
>> >> > I now get a compile error:Sub or Function not defined. "Wookbooks"
>> >> > gets
>> >> > highlighted.
>> >> > --
>> >> > Thank you!!
>> >> >
>> >> > Mountaineer
>> >> >
>> >> >
>> >> > "r" wrote:
>> >> >
>> >> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
>> >> > >
>> >> > > Set DestSh = Workbooks("Current").Worksheets("sheet1")
>> >> > >
>> >> > > regards
>> >> > > r
>> >> > >
>> >> > >
>> >> > >
>> >> > > Il mio ultimo lavoro ...
>> >> > > http://excelvba.altervista.org/blog/...ternative.html
>> >> > >
>> >> > >
>> >> > > "Mountaineer" wrote:
>> >> > >
>> >> > > > Hi,
>> >> > > >
>> >> > > > I'm want to autofilter in "Master.xls" sheet1 and paste the
>> >> > > > results
>> >> > > > to the
>> >> > > > bottom of existing "Current.xls" sheet1. I found a macro by Ron
>> >> > > > de
>> >> > > > Bruin
>> >> > > > that works if pasting to a worksheet in the same workbook. I
>> >> > > > tried
>> >> > > > to modify
>> >> > > > it but have not had any luck.
>> >> > > >
>> >> > > >
>> >> > > > Dim My_Range As Range
>> >> > > > Dim DestSh As Worksheet
>> >> > > > Dim CalcMode As Long
>> >> > > > Dim ViewMode As Long
>> >> > > > Dim FilterCriteria As String
>> >> > > > Dim CCount As Long
>> >> > > > Dim rng As Range
>> >> > > >
>> >> > > > 'set filter ranger on Sheet 1 of Master.xls
>> >> > > > Windows("Master.xls").Activate
>> >> > > > Set My_Range = Worksheets("sheet1").Range("A2:H" &
>> >> > > > LastRow(Worksheets("Sheet1")))
>> >> > > > My_Range.Parent.Select
>> >> > > >
>> >> > > > 'set the destination worksheet. This is where it bombs!
>> >> > > >
>> >> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
>> >> > > >
>> >> > > > 'change ScreenUpdating, Calculation, EnableEvents,...
>> >> > > >
>> >> > > > With Application
>> >> > > > CalcMode = .Calculation
>> >> > > > .Calculation = xlCalculationManual
>> >> > > > .ScreenUpdating = False
>> >> > > > .EnableEvents = False
>> >> > > >
>> >> > > > End With
>> >> > > > ViewMode = ActiveWindow.View
>> >> > > > ActiveWindow.View = xlNormalView
>> >> > > > ActiveSheet.DisplayPageBreaks = False
>> >> > > >
>> >> > > > 'Firstly, remove the Autofilter
>> >> > > >
>> >> > > > My_Range.Parent.AutoFilterMode = False
>> >> > > >
>> >> > > >
>> >> > > > 'Filter and set the filter field and filter criteria:
>> >> > > >
>> >> > > > My_Range.AutoFilter Field:=1, Criteria1:="=3015"
>> >> > > >
>> >> > > > 'Check if there are not more then 8192 areas (limit of areas
>> >> > > > that Excel
>> >> > > > can copy)
>> >> > > >
>> >> > > > CCount = 0
>> >> > > > On Error Resume Next
>> >> > > > CCount =
>> >> > > > My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
>> >> > > > On Error GoTo 0
>> >> > > > If CCount = 0 Then
>> >> > > > MsgBox "There are more than 8192 areas:" _
>> >> > > > & vbNewLine & "It is not possible to copy the visible
>> >> > > > data." _
>> >> > > > & vbNewLine & "Tip:Sort your data before you use this
>> >> > > > macro.", _
>> >> > > > vbOKOnly, "Copy to worksheet"
>> >> > > > Else
>> >> > > > 'Copy the visible data and use PasteSpecial to paste to the
>> >> > > > Desth
>> >> > > >
>> >> > > > With My_Range.Parent.AutoFilter.Range
>> >> > > > On Error Resume Next
>> >> > > > 'Set rng to the visible cells in My_Range without the header
>> >> > > > row
>> >> > > > Set rng = .Offset(1, 0).Resize(.Rows.Count - 1,
>> >> > > > .Columns.Count)
>> >> > > > _
>> >> > > > .SpecialCells(xlCellTypeVisible)
>> >> > > > On Error GoTo 0
>> >> > > > If Not rng Is Nothing Then
>> >> > > > 'copy and paste the cells into Destsh below the existing
>> >> > > > data
>> >> > > > rng.Copy
>> >> > > > With DestSh.Range("A" & LastRow(DestSh) + 1)
>> >> > > > .PasteSpecial Paste:=8
>> >> > > > .PasteSpecial xlPasteValues
>> >> > > > .PasteSpecial xlPasteFormats
>> >> > > > Application.CutCopyMode = False
>> >> > > >
>> >> > > > End With
>> >> > > > End If
>> >> > > > End With
>> >> > > > End If
>> >> > > >
>> >> > > > 'close autofilter
>> >> > > >
>> >> > > > My_Range.Parent.AutoFilterMode = False
>> >> > > >
>> >> > > > 'Restore screenupdating, calculation, enableevents...
>> >> > > >
>> >> > > > ActiveWindow.View = ViewMode
>> >> > > > Application.Goto DestSh.Range("a2")
>> >> > > >
>> >> > > > With Application
>> >> > > > .ScreenUpdating = True
>> >> > > > .EnableEvents = True
>> >> > > > .Calculation = CalcMode
>> >> > > >
>> >> > > > End With
>> >> > > >
>> >> > > > End Sub
>> >> > > >
>> >> > > > Function LastRow(sh As Worksheet)
>> >> > > > On Error Resume Next
>> >> > > > LastRow = sh.Cells.Find(what:="*", _
>> >> > > > After:=sh.Range("a2"), _
>> >> > > > Lookat:=xlPart, _
>> >> > > > LookIn:=xlValues, _
>> >> > > > SearchOrder:=xlByRows, _
>> >> > > > SearchDirection:=xlPrevious, _
>> >> > > > MatchCase:=False).Row
>> >> > > > On Error GoTo 0
>> >> > > > End Function
>> >> > > > --
>> >> > > > Thank you!!
>> >> > > >
>> >> > > > Mountaineer
>>
>>

Hi Patrick,

Sorry...that didn't work. I now get a "type mismatch" error.

Set DestSh = Workbooks("Current.xls").Worksheets("Sheet1")
--
Thank you!!

Mountaineer


"Patrick Molloy" wrote:

> probably needs the .xls extension
>
> Set DestSh = Workbooks("Current.xls").Worksheets("Sheet1")
>
>
>
>
> "Mountaineer" <(E-Mail Removed)> wrote in message
> news:BA623DBA-ECD3-4FB1-A03C-(E-Mail Removed)...
> > Hi,
> >
> > I made sure both "Current" and "Master" spreadsheets are open. Below is a
> > "copy" since I don't trust my spelling. I am still getting the "Subscript
> > out of range" error. Is it possible it's because I don't have anything
> > DIM
> > as a workbook?
> >
> > thanks for your help.
> >
> >
> > Set DestSh = Workbooks("Current").Worksheets("Sheet1")
> > --
> > Thank you!!
> >
> > Mountaineer
> >
> >
> > "Patrick Molloy" wrote:
> >
> >> make sure that the name of the destination workbook and worksheet are
> >> correct and that it is open
> >>
> >> "Mountaineer" <(E-Mail Removed)> wrote in message
> >> news:73FD4104-C507-43EF-A7DE-(E-Mail Removed)...
> >> > I am so embarrassed. I fixed my misspelling. Now I get "subscript out
> >> > of
> >> > range" still at the same place "Set Destsh...."
> >> >
> >> > Thank you for your patience.
> >> >
> >> >
> >> > --
> >> > Thank you!!
> >> >
> >> > Mountaineer
> >> >
> >> >
> >> > "r" wrote:
> >> >
> >> >> Workbooks
> >> >>
> >> >> regards
> >> >> r
> >> >>
> >> >> Il mio ultimo lavoro ...
> >> >> http://excelvba.altervista.org/blog/...ternative.html
> >> >>
> >> >>
> >> >> "Mountaineer" wrote:
> >> >>
> >> >> > Thank you for such a quick response.
> >> >> >
> >> >> > I now get a compile error:Sub or Function not defined. "Wookbooks"
> >> >> > gets
> >> >> > highlighted.
> >> >> > --
> >> >> > Thank you!!
> >> >> >
> >> >> > Mountaineer
> >> >> >
> >> >> >
> >> >> > "r" wrote:
> >> >> >
> >> >> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
> >> >> > >
> >> >> > > Set DestSh = Workbooks("Current").Worksheets("sheet1")
> >> >> > >
> >> >> > > regards
> >> >> > > r
> >> >> > >
> >> >> > >
> >> >> > >
> >> >> > > Il mio ultimo lavoro ...
> >> >> > > http://excelvba.altervista.org/blog/...ternative.html
> >> >> > >
> >> >> > >
> >> >> > > "Mountaineer" wrote:
> >> >> > >
> >> >> > > > Hi,
> >> >> > > >
> >> >> > > > I'm want to autofilter in "Master.xls" sheet1 and paste the
> >> >> > > > results
> >> >> > > > to the
> >> >> > > > bottom of existing "Current.xls" sheet1. I found a macro by Ron
> >> >> > > > de
> >> >> > > > Bruin
> >> >> > > > that works if pasting to a worksheet in the same workbook. I
> >> >> > > > tried
> >> >> > > > to modify
> >> >> > > > it but have not had any luck.
> >> >> > > >
> >> >> > > >
> >> >> > > > Dim My_Range As Range
> >> >> > > > Dim DestSh As Worksheet
> >> >> > > > Dim CalcMode As Long
> >> >> > > > Dim ViewMode As Long
> >> >> > > > Dim FilterCriteria As String
> >> >> > > > Dim CCount As Long
> >> >> > > > Dim rng As Range
> >> >> > > >
> >> >> > > > 'set filter ranger on Sheet 1 of Master.xls
> >> >> > > > Windows("Master.xls").Activate
> >> >> > > > Set My_Range = Worksheets("sheet1").Range("A2:H" &
> >> >> > > > LastRow(Worksheets("Sheet1")))
> >> >> > > > My_Range.Parent.Select
> >> >> > > >
> >> >> > > > 'set the destination worksheet. This is where it bombs!
> >> >> > > >
> >> >> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
> >> >> > > >
> >> >> > > > 'change ScreenUpdating, Calculation, EnableEvents,...
> >> >> > > >
> >> >> > > > With Application
> >> >> > > > CalcMode = .Calculation
> >> >> > > > .Calculation = xlCalculationManual
> >> >> > > > .ScreenUpdating = False
> >> >> > > > .EnableEvents = False
> >> >> > > >
> >> >> > > > End With
> >> >> > > > ViewMode = ActiveWindow.View
> >> >> > > > ActiveWindow.View = xlNormalView
> >> >> > > > ActiveSheet.DisplayPageBreaks = False
> >> >> > > >
> >> >> > > > 'Firstly, remove the Autofilter
> >> >> > > >
> >> >> > > > My_Range.Parent.AutoFilterMode = False
> >> >> > > >
> >> >> > > >
> >> >> > > > 'Filter and set the filter field and filter criteria:
> >> >> > > >
> >> >> > > > My_Range.AutoFilter Field:=1, Criteria1:="=3015"
> >> >> > > >
> >> >> > > > 'Check if there are not more then 8192 areas (limit of areas
> >> >> > > > that Excel
> >> >> > > > can copy)
> >> >> > > >
> >> >> > > > CCount = 0
> >> >> > > > On Error Resume Next
> >> >> > > > CCount =
> >> >> > > > My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
> >> >> > > > On Error GoTo 0
> >> >> > > > If CCount = 0 Then
> >> >> > > > MsgBox "There are more than 8192 areas:" _
> >> >> > > > & vbNewLine & "It is not possible to copy the visible
> >> >> > > > data." _
> >> >> > > > & vbNewLine & "Tip:Sort your data before you use this
> >> >> > > > macro.", _
> >> >> > > > vbOKOnly, "Copy to worksheet"
> >> >> > > > Else
> >> >> > > > 'Copy the visible data and use PasteSpecial to paste to the
> >> >> > > > Desth
> >> >> > > >
> >> >> > > > With My_Range.Parent.AutoFilter.Range
> >> >> > > > On Error Resume Next
> >> >> > > > 'Set rng to the visible cells in My_Range without the header
> >> >> > > > row
> >> >> > > > Set rng = .Offset(1, 0).Resize(.Rows.Count - 1,
> >> >> > > > .Columns.Count)
> >> >> > > > _
> >> >> > > > .SpecialCells(xlCellTypeVisible)
> >> >> > > > On Error GoTo 0
> >> >> > > > If Not rng Is Nothing Then
> >> >> > > > 'copy and paste the cells into Destsh below the existing
> >> >> > > > data
> >> >> > > > rng.Copy
> >> >> > > > With DestSh.Range("A" & LastRow(DestSh) + 1)
> >> >> > > > .PasteSpecial Paste:=8
> >> >> > > > .PasteSpecial xlPasteValues
> >> >> > > > .PasteSpecial xlPasteFormats
> >> >> > > > Application.CutCopyMode = False
> >> >> > > >
> >> >> > > > End With
> >> >> > > > End If
> >> >> > > > End With
> >> >> > > > End If
> >> >> > > >
> >> >> > > > 'close autofilter
> >> >> > > >
> >> >> > > > My_Range.Parent.AutoFilterMode = False
> >> >> > > >
> >> >> > > > 'Restore screenupdating, calculation, enableevents...
> >> >> > > >
> >> >> > > > ActiveWindow.View = ViewMode
> >> >> > > > Application.Goto DestSh.Range("a2")
> >> >> > > >
> >> >> > > > With Application
> >> >> > > > .ScreenUpdating = True
> >> >> > > > .EnableEvents = True
> >> >> > > > .Calculation = CalcMode
> >> >> > > >
> >> >> > > > End With
> >> >> > > >
> >> >> > > > End Sub
> >> >> > > >
> >> >> > > > Function LastRow(sh As Worksheet)
> >> >> > > > On Error Resume Next
> >> >> > > > LastRow = sh.Cells.Find(what:="*", _
> >> >> > > > After:=sh.Range("a2"), _
> >> >> > > > Lookat:=xlPart, _
> >> >> > > > LookIn:=xlValues, _
> >> >> > > > SearchOrder:=xlByRows, _
> >> >> > > > SearchDirection:=xlPrevious, _
> >> >> > > > MatchCase:=False).Row
> >> >> > > > On Error GoTo 0
> >> >> > > > End Function
> >> >> > > > --
> >> >> > > > Thank you!!
> >> >> > > >
> >> >> > > > Mountaineer
> >>
> >>

do you have

DIM DestSh As Worksheet

does the workbook called Current.xls have a sheet named Sheet1 ?

"Mountaineer" <(E-Mail Removed)> wrote in message
news:57618B63-E8F4-4BE7-B1D6-(E-Mail Removed)...
> Hi Patrick,
>
> Sorry...that didn't work. I now get a "type mismatch" error.
>
> Set DestSh = Workbooks("Current.xls").Worksheets("Sheet1")
> --
> Thank you!!
>
> Mountaineer
>
>
> "Patrick Molloy" wrote:
>
>> probably needs the .xls extension
>>
>> Set DestSh = Workbooks("Current.xls").Worksheets("Sheet1")
>>
>>
>>
>>
>> "Mountaineer" <(E-Mail Removed)> wrote in message
>> news:BA623DBA-ECD3-4FB1-A03C-(E-Mail Removed)...
>> > Hi,
>> >
>> > I made sure both "Current" and "Master" spreadsheets are open. Below
>> > is a
>> > "copy" since I don't trust my spelling. I am still getting the
>> > "Subscript
>> > out of range" error. Is it possible it's because I don't have anything
>> > DIM
>> > as a workbook?
>> >
>> > thanks for your help.
>> >
>> >
>> > Set DestSh = Workbooks("Current").Worksheets("Sheet1")
>> > --
>> > Thank you!!
>> >
>> > Mountaineer
>> >
>> >
>> > "Patrick Molloy" wrote:
>> >
>> >> make sure that the name of the destination workbook and worksheet are
>> >> correct and that it is open
>> >>
>> >> "Mountaineer" <(E-Mail Removed)> wrote in message
>> >> news:73FD4104-C507-43EF-A7DE-(E-Mail Removed)...
>> >> > I am so embarrassed. I fixed my misspelling. Now I get "subscript
>> >> > out
>> >> > of
>> >> > range" still at the same place "Set Destsh...."
>> >> >
>> >> > Thank you for your patience.
>> >> >
>> >> >
>> >> > --
>> >> > Thank you!!
>> >> >
>> >> > Mountaineer
>> >> >
>> >> >
>> >> > "r" wrote:
>> >> >
>> >> >> Workbooks
>> >> >>
>> >> >> regards
>> >> >> r
>> >> >>
>> >> >> Il mio ultimo lavoro ...
>> >> >> http://excelvba.altervista.org/blog/...ternative.html
>> >> >>
>> >> >>
>> >> >> "Mountaineer" wrote:
>> >> >>
>> >> >> > Thank you for such a quick response.
>> >> >> >
>> >> >> > I now get a compile error:Sub or Function not defined.
>> >> >> > "Wookbooks"
>> >> >> > gets
>> >> >> > highlighted.
>> >> >> > --
>> >> >> > Thank you!!
>> >> >> >
>> >> >> > Mountaineer
>> >> >> >
>> >> >> >
>> >> >> > "r" wrote:
>> >> >> >
>> >> >> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
>> >> >> > >
>> >> >> > > Set DestSh = Workbooks("Current").Worksheets("sheet1")
>> >> >> > >
>> >> >> > > regards
>> >> >> > > r
>> >> >> > >
>> >> >> > >
>> >> >> > >
>> >> >> > > Il mio ultimo lavoro ...
>> >> >> > > http://excelvba.altervista.org/blog/...ternative.html
>> >> >> > >
>> >> >> > >
>> >> >> > > "Mountaineer" wrote:
>> >> >> > >
>> >> >> > > > Hi,
>> >> >> > > >
>> >> >> > > > I'm want to autofilter in "Master.xls" sheet1 and paste the
>> >> >> > > > results
>> >> >> > > > to the
>> >> >> > > > bottom of existing "Current.xls" sheet1. I found a macro by
>> >> >> > > > Ron
>> >> >> > > > de
>> >> >> > > > Bruin
>> >> >> > > > that works if pasting to a worksheet in the same workbook. I
>> >> >> > > > tried
>> >> >> > > > to modify
>> >> >> > > > it but have not had any luck.
>> >> >> > > >
>> >> >> > > >
>> >> >> > > > Dim My_Range As Range
>> >> >> > > > Dim DestSh As Worksheet
>> >> >> > > > Dim CalcMode As Long
>> >> >> > > > Dim ViewMode As Long
>> >> >> > > > Dim FilterCriteria As String
>> >> >> > > > Dim CCount As Long
>> >> >> > > > Dim rng As Range
>> >> >> > > >
>> >> >> > > > 'set filter ranger on Sheet 1 of Master.xls
>> >> >> > > > Windows("Master.xls").Activate
>> >> >> > > > Set My_Range = Worksheets("sheet1").Range("A2:H" &
>> >> >> > > > LastRow(Worksheets("Sheet1")))
>> >> >> > > > My_Range.Parent.Select
>> >> >> > > >
>> >> >> > > > 'set the destination worksheet. This is where it bombs!
>> >> >> > > >
>> >> >> > > > Set DestSh = Worksheets("[Current.xls]sheet1")
>> >> >> > > >
>> >> >> > > > 'change ScreenUpdating, Calculation, EnableEvents,...
>> >> >> > > >
>> >> >> > > > With Application
>> >> >> > > > CalcMode = .Calculation
>> >> >> > > > .Calculation = xlCalculationManual
>> >> >> > > > .ScreenUpdating = False
>> >> >> > > > .EnableEvents = False
>> >> >> > > >
>> >> >> > > > End With
>> >> >> > > > ViewMode = ActiveWindow.View
>> >> >> > > > ActiveWindow.View = xlNormalView
>> >> >> > > > ActiveSheet.DisplayPageBreaks = False
>> >> >> > > >
>> >> >> > > > 'Firstly, remove the Autofilter
>> >> >> > > >
>> >> >> > > > My_Range.Parent.AutoFilterMode = False
>> >> >> > > >
>> >> >> > > >
>> >> >> > > > 'Filter and set the filter field and filter criteria:
>> >> >> > > >
>> >> >> > > > My_Range.AutoFilter Field:=1, Criteria1:="=3015"
>> >> >> > > >
>> >> >> > > > 'Check if there are not more then 8192 areas (limit of
>> >> >> > > > areas
>> >> >> > > > that Excel
>> >> >> > > > can copy)
>> >> >> > > >
>> >> >> > > > CCount = 0
>> >> >> > > > On Error Resume Next
>> >> >> > > > CCount =
>> >> >> > > > My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
>> >> >> > > > On Error GoTo 0
>> >> >> > > > If CCount = 0 Then
>> >> >> > > > MsgBox "There are more than 8192 areas:" _
>> >> >> > > > & vbNewLine & "It is not possible to copy the visible
>> >> >> > > > data." _
>> >> >> > > > & vbNewLine & "Tip:Sort your data before you use this
>> >> >> > > > macro.", _
>> >> >> > > > vbOKOnly, "Copy to worksheet"
>> >> >> > > > Else
>> >> >> > > > 'Copy the visible data and use PasteSpecial to paste to
>> >> >> > > > the
>> >> >> > > > Desth
>> >> >> > > >
>> >> >> > > > With My_Range.Parent.AutoFilter.Range
>> >> >> > > > On Error Resume Next
>> >> >> > > > 'Set rng to the visible cells in My_Range without the
>> >> >> > > > header
>> >> >> > > > row
>> >> >> > > > Set rng = .Offset(1, 0).Resize(.Rows.Count - 1,
>> >> >> > > > .Columns.Count)
>> >> >> > > > _
>> >> >> > > > .SpecialCells(xlCellTypeVisible)
>> >> >> > > > On Error GoTo 0
>> >> >> > > > If Not rng Is Nothing Then
>> >> >> > > > 'copy and paste the cells into Destsh below the
>> >> >> > > > existing
>> >> >> > > > data
>> >> >> > > > rng.Copy
>> >> >> > > > With DestSh.Range("A" & LastRow(DestSh) + 1)
>> >> >> > > > .PasteSpecial Paste:=8
>> >> >> > > > .PasteSpecial xlPasteValues
>> >> >> > > > .PasteSpecial xlPasteFormats
>> >> >> > > > Application.CutCopyMode = False
>> >> >> > > >
>> >> >> > > > End With
>> >> >> > > > End If
>> >> >> > > > End With
>> >> >> > > > End If
>> >> >> > > >
>> >> >> > > > 'close autofilter
>> >> >> > > >
>> >> >> > > > My_Range.Parent.AutoFilterMode = False
>> >> >> > > >
>> >> >> > > > 'Restore screenupdating, calculation, enableevents...
>> >> >> > > >
>> >> >> > > > ActiveWindow.View = ViewMode
>> >> >> > > > Application.Goto DestSh.Range("a2")
>> >> >> > > >
>> >> >> > > > With Application
>> >> >> > > > .ScreenUpdating = True
>> >> >> > > > .EnableEvents = True
>> >> >> > > > .Calculation = CalcMode
>> >> >> > > >
>> >> >> > > > End With
>> >> >> > > >
>> >> >> > > > End Sub
>> >> >> > > >
>> >> >> > > > Function LastRow(sh As Worksheet)
>> >> >> > > > On Error Resume Next
>> >> >> > > > LastRow = sh.Cells.Find(what:="*", _
>> >> >> > > > After:=sh.Range("a2"), _
>> >> >> > > > Lookat:=xlPart, _
>> >> >> > > > LookIn:=xlValues, _
>> >> >> > > > SearchOrder:=xlByRows, _
>> >> >> > > > SearchDirection:=xlPrevious, _
>> >> >> > > > MatchCase:=False).Row
>> >> >> > > > On Error GoTo 0
>> >> >> > > > End Function
>> >> >> > > > --
>> >> >> > > > Thank you!!
>> >> >> > > >
>> >> >> > > > Mountaineer
>> >>
>> >>