View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default copy table to new sheet

Try:

Option Explicit
Sub testme03()

Dim FromWks As Worksheet
Dim ToWks As Worksheet
Dim RngToFilter As Range
Dim RngToCopy As Range

Set FromWks = Worksheets("A")
Set ToWks = Worksheets("B")

With FromWks
'remove any existing filter
.AutoFilterMode = False

Set RngToFilter = .Range("CQ15", .Cells(.Rows.Count, "CQ").End(xlUp))

RngToFilter.AutoFilter field:=1, Criteria1:="<"

If .AutoFilter.Range.Columns(1).Cells.SpecialCells(xl CellTypeVisible) _
.Cells.Count = 1 Then
'only the headers are visible, nothing to copy???
Else
With RngToFilter
'skip the header and resize to avoid an
'extra row at the bottom
Set RngToCopy = .Resize(.Rows.Count - 1, 1).Offset(1, 0)
End With
End If
End With

'in newer versions of excel (xl97 and higher), the default is to
'copy the visible cells
RngToCopy.Copy
ToWks.Range("a3").PasteSpecial Paste:=xlPasteValues

End Sub


Scott wrote:

I am new to macros and this is my first shot. I would like to filter data
from CQ in sheet A then copy data from CJ16 to CO16 down to the last row
based on the filtered CQ data. The paste in A3 in sheet B. The following
code works except it does not find the last row with data, any advice?

Sheets("A").Select
ActiveSheet.Range("$CQ$15:$CQ$103").AutoFilter Field:=1, Criteria1:="<"
Range("CJ16:CO60").Select
Selection.Copy
Sheets("B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("J23").Select
End Sub

Thanks


--

Dave Peterson