copy table to new sheet

[Scott]

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]

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(xlCellTypeVisible) _
.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

 

[Dave Peterson]

Oops. There's a bug in that code if there's only headers visible.

Use this instead:

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(xlCellTypeVisible) _
.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

'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 If
End With

End Sub

Notice the .copy stuff has been moved into the else portion--where I know
there's data to copy.


<<snipped>>

 

[Scott]

This does filter up to the last cell but I would like to copy CJ16:CO16 down
as it currently copies CQ down. I would still like to have it look to CQ for
the last row and then copy CJ16:CO16 down based on the last CQ data. Then
copy it to the "B" sheet as it does to A3:F3 down. I know it is a little
confusing sorry, don't know much about this (if any).

Thank You

 

[Dave Peterson]

Try changing this line:

Set RngToCopy = .Resize(.Rows.Count - 1, 1).Offset(1, 0)

to

Set RngToCopy = .offset(1,-7).Resize(.Rows.Count - 1, 6)

Since it's filtering by CQ, the .offset(1,-7) takes you back to column CJ, but
down a row from the header.

The .resize(.rows.count-1,6) says to make the range 6 columns wide (CJ:CO), but
not include any extra row at the bottom.

 

[Scott]

thanks your great....

Try changing this line:

Set RngToCopy = .Resize(.Rows.Count - 1, 1).Offset(1, 0)

to

Set RngToCopy = .offset(1,-7).Resize(.Rows.Count - 1, 6)

Since it's filtering by CQ, the .offset(1,-7) takes you back to column CJ, but
down a row from the header.

The .resize(.rows.count-1,6) says to make the range 6 columns wide (CJ:CO), but
not include any extra row at the bottom.