Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 577
Default copy table to new sheet

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

  #2   Report Post  
Posted to microsoft.public.excel.programming
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
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default copy table to new sheet

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(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

'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.


Dave Peterson wrote:

<<snipped
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 577
Default copy table to new sheet


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" wrote:

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(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

'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.


Dave Peterson wrote:

<<snipped

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default copy table to new sheet

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 wrote:

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" wrote:

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(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

'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.


Dave Peterson wrote:

<<snipped


--

Dave Peterson


  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 577
Default copy table to new sheet

thanks your great....



"Dave Peterson" wrote:

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 wrote:

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" wrote:

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(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

'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.


Dave Peterson wrote:

<<snipped


--

Dave Peterson

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
to copy pivot table as new sheet with same format pol Excel Discussion (Misc queries) 3 May 5th 10 08:42 PM
copy same cell from different ascending sheet into a table? Roog Excel Worksheet Functions 4 February 8th 07 04:36 PM
Copy Records from Access Database table(more than 5 lakh records in this table) to Excel Sheet divya Excel Programming 1 October 26th 06 12:12 PM
I need to copy table from one sheet to anothe Maya Excel Worksheet Functions 2 March 3rd 05 06:22 PM
Copy Table to New Sheet HamishM[_6_] Excel Programming 0 February 2nd 04 10:51 PM


All times are GMT +1. The time now is 04:09 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"