Hi Dave,

That worked really well, with one exception.

It doesn't push the data beneath the destination down; instead it replaced
it (wrote over it).

Almost there :-)

Thanks!

"Dave Peterson" wrote:

Without the formatting...

And I like to specify where I want to paste--worksheet and range name.

I did assume that both SpecDate and TrData are single cells.

Option Explicit
Sub testme02()

Dim VisRng As Range
Dim HowManyVisible As Long
Dim myRng As Range
Dim DestCell As Range

Set myRng = Selection

HowManyVisible = myRng.Columns(1) _
.SpecialCells(xlCellTypeVisible).Cells.Count

Set VisRng = myRng.Cells.SpecialCells(xlCellTypeVisible)

If HowManyVisible = 1 Then
Set DestCell = Worksheets("Sheet2").Range("trdate").Offset(1, 0)
Else
Set DestCell = Worksheets("sheet3").Range("SpecDate").Offset(1, 0)
End If

VisRng.Copy _
Destination:=DestCell

With DestCell
.Resize(HowManyVisible, 2).Offset(0, 1).Delete shift:=xlToLeft
End With

End Sub


Joyce wrote:

Hi Dave,

I made your suggested change - thanks.

However, it still doesn't work when I filter my date, then select the first
4 columns of filtered data and run the macro when the data I select resides
on non-contiguous rows.

My goal is to copy the first 4 columns of data, then remove the 2nd and 3rd
columns (I only need to pull data from columns 1 and 4).

It works fine when 1 singular row or contiguous rows are the result of the
advanced filter; the minute they are non-contiguous - no longer works.

Thanks

"Dave Peterson" wrote:

When you use this line:
i = rng.Rows.Count
i isn't the number of rows in rng. It's the number of rows in the first area of
that range.

If you want to see how many rows are in that range, I'd use:

i = rng.columns(1).cells.count


Joyce wrote:

Hello,

I apply an advanced filter to data on Sht1 and then select the first few
columns of the filtered data and run the following macro to copy to Sht2.

All works well for 1 row, or for contiguous rows. However, when the results
are non-contiguous rows, it doesn't work at all.

Any help would be greatly appreciated: Here is my code:

Dim rng As Range, i As Long
Selection.SpecialCells(xlCellTypeVisible).Select
Set rng = Selection
rng.Select


i = rng.Rows.Count
If i = 1 Then
rng.Copy
Application.Goto Reference:="TrDate"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Application.Goto Reference:="SpecDate"


Else
rng.Copy
Application.Goto Reference:="SpecDate"
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(0, 1).Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.RowHeight = 27
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Delete Shift:=xlUp
Selection.RowHeight = 27


End If

--

Dave Peterson
.


--

Dave Peterson
.