Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
make sure that the name of the destination workbook and worksheet are
correct and that it is open "Mountaineer" wrote in message ... 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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
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" wrote in message ... 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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
probably needs the .xls extension
Set DestSh = Workbooks("Current.xls").Worksheets("Sheet1") "Mountaineer" wrote in message ... 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" wrote in message ... 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 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
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" wrote in message ... 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" wrote in message ... 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 |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Autofilter in 1 workbook and paste in 2nd workbook
do you have
DIM DestSh As Worksheet does the workbook called Current.xls have a sheet named Sheet1 ? "Mountaineer" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy Autofilter Source Workbook A result in Destination Workbook BSheet1 | Excel Programming | |||
HELP: Use the autofilter result on one workbook to filter the next list on another workbook | Excel Programming | |||
HELP: Use the autofilter result on one workbook to filter the next list on another workbook | Excel Worksheet Functions | |||
Need a macro to copy a range in one workbook and paste into another workbook | Excel Programming | |||
Copy a range of cells in an unopened workbook and paste it to the current workbook | Excel Programming |