S
sgl
Tom Hi,
I have copied your CopyFilter sub from the Contextures site but want to copy
to a new worksheet a "specific range" rather than the whole of the filtered
area. I have amended your code as shown below but cannot get the range
parameters right. Your assistance please.
Sub CopyFilter2()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Long
Application.ScreenUpdating = False
Range("A5").AutoFilter Field:=1, Criteria1:="01"
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("Sheet2").Range("A2:L25").ClearContents
Set rng = ActiveSheet.AutoFilter.Range
' I have added this to count visible rows
rng3 = rng.Columns(4).SpecialCells(xlCellTypeVisible).Count - 1
' Range I want to copy starts in the first row column 4 of filtered
' range to the last cell in say Column 10 of the filtered range
Range(Cells(rng.Offset(1, 4), rng.Columns(4)), _
Cells(rng3, rng.Columns(10))).Copy
Worksheets("Sheet2").Range("A2").PasteSpecial Paste:=xlValues
End If
On Error Resume Next
ActiveSheet.ShowAllData
Application.ScreenUpdating = True
End Sub
Many thanks in davance/sgl
I have copied your CopyFilter sub from the Contextures site but want to copy
to a new worksheet a "specific range" rather than the whole of the filtered
area. I have amended your code as shown below but cannot get the range
parameters right. Your assistance please.
Sub CopyFilter2()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Long
Application.ScreenUpdating = False
Range("A5").AutoFilter Field:=1, Criteria1:="01"
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("Sheet2").Range("A2:L25").ClearContents
Set rng = ActiveSheet.AutoFilter.Range
' I have added this to count visible rows
rng3 = rng.Columns(4).SpecialCells(xlCellTypeVisible).Count - 1
' Range I want to copy starts in the first row column 4 of filtered
' range to the last cell in say Column 10 of the filtered range
Range(Cells(rng.Offset(1, 4), rng.Columns(4)), _
Cells(rng3, rng.Columns(10))).Copy
Worksheets("Sheet2").Range("A2").PasteSpecial Paste:=xlValues
End If
On Error Resume Next
ActiveSheet.ShowAllData
Application.ScreenUpdating = True
End Sub
Many thanks in davance/sgl