Copy Filtered Rows
 

I am using Autofilter programmatically to filter a database spreadshee
and then using a modified CopyFilter routine by Tom Ogilvy to copy th
rows to a TempSheet which is then copied and transposed to ViewShee
for user viewing.

The problem is not all of the rows are copied from TempSheet t
ViewSheet. I realize I may not need TempSheet to act as an intermediar
- but I'm not sure how to avoid it ... yet.

Here is Toms original code...

Sub CopyFilter()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range

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").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Sheet2").Range("A1")
End If
ActiveSheet.ShowAllData

End Sub


and my modified code...

Sub CopyFilter()
Dim rng As Range
Dim rng2 As Range

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
Worksheets("TempSheet").Cells.Clear
Worksheets("ViewSheet").Cells.Clear
If rng2 Is Nothing Then
'MsgBox "No data found"
Else
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(0, 0).Resize(rng.Rows.Count).Copy _
Destination:=Worksheets("TempSheet").Range("A1")
End If
Worksheets("TempSheet").Select
Selection.Copy
Sheets("ViewSheet").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=True
Worksheets("Total_Hardware").Select
ActiveSheet.ShowAllData
Worksheets("ViewSheet").Select
Cells(22, 1).Value = "Back To"
Cells(22, 1).Font.Bold = True
Cells(22, 1).HorizontalAlignment = xlCenter
LinkText = "Summary!A1"
ActiveSheet.Hyperlinks.Add Anchor:=Cells(22, 2), _
Address:="", _
SubAddress:=LinkText
TextToDisplay:="Summary"
Cells(22, 2).Font.Bold = True
Cells(22, 2).HorizontalAlignment = xlCenter
End Sub

Any help is appreciated ! Thanks

--
Message posted from http://www.ExcelForum.com

Copy Filtered Rows
 

Actually, the code you cite was a modification of Debra Dalgleish's code.

anyway, you can try these lines:

Worksheets("TempSheet").Select
Range("A1").CurrentRegion.Copy
Sheets("ViewSheet").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:= _
False, Transpose:=True

--
Regards,
Tom Ogilvy


"woody334 " wrote in message
...
I am using Autofilter programmatically to filter a database spreadsheet
and then using a modified CopyFilter routine by Tom Ogilvy to copy the
rows to a TempSheet which is then copied and transposed to ViewSheet
for user viewing.

The problem is not all of the rows are copied from TempSheet to
ViewSheet. I realize I may not need TempSheet to act as an intermediary
- but I'm not sure how to avoid it ... yet.

Here is Toms original code...

Sub CopyFilter()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range

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").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Sheet2").Range("A1")
End If
ActiveSheet.ShowAllData

End Sub


and my modified code...

Sub CopyFilter()
Dim rng As Range
Dim rng2 As Range

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
Worksheets("TempSheet").Cells.Clear
Worksheets("ViewSheet").Cells.Clear
If rng2 Is Nothing Then
'MsgBox "No data found"
Else
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(0, 0).Resize(rng.Rows.Count).Copy _
Destination:=Worksheets("TempSheet").Range("A1")
End If
Worksheets("TempSheet").Select
Selection.Copy
Sheets("ViewSheet").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True
Worksheets("Total_Hardware").Select
ActiveSheet.ShowAllData
Worksheets("ViewSheet").Select
Cells(22, 1).Value = "Back To"
Cells(22, 1).Font.Bold = True
Cells(22, 1).HorizontalAlignment = xlCenter
LinkText = "Summary!A1"
ActiveSheet.Hyperlinks.Add Anchor:=Cells(22, 2), _
Address:="", _
SubAddress:=LinkText,
TextToDisplay:="Summary"
Cells(22, 2).Font.Bold = True
Cells(22, 2).HorizontalAlignment = xlCenter
End Sub

Any help is appreciated ! Thanks !


---
Message posted from http://www.ExcelForum.com/

Copy Filtered Rows
 

Thanks Tom. The reason I thought it was your code was due to the cod
posted at http://contextures.com/xlautofilter03.html#Copy

The modification you provided works - although it tends to copy man
blank rows over as well.

I do know how many columns I need to copy and can extract the number o
rows. I just can't seem to create a range without VBA complaining.

I.E.
LastRow = Worksheets("TempView").Range("A65536").End(xlUp)
RangeText = "A1:S" & LastRow

I assume this is because LastRow is a number.

I am still open to ideas and suggestions.

many thanks

--
Message posted from http://www.ExcelForum.com

Copy Filtered Rows
 

Whoops .... it actually complains about a line I did not include in m
post...

I.E.
LastRow = Worksheets("TempView").Range("A65536").End(xlUp)
RangeText = "A1:S" & LastRow
Range(RangeText).Select

Again - thanks Tom.... and everyone else

--
Message posted from http://www.ExcelForum.com

Copy Filtered Rows
 

LastRow = Worksheets("TempView").Range("A65536").End(xlUp)
RangeText = "A1:S" & LastRow

lastrow will hold the value in the lastcell, not the row number. change it
to

LastRow = Worksheets("TempView").Range("A65536").End(xlUp).R ow
RangeText = "A1:S" & LastRow

Debra has posted the modification I made to her code. It is no big deal,
but the code does the same work twice so it is not a particularly good
example of how to do the task. It is possible that it was adapted from
another task that had a different purpose and never got cleaned up.

--
Regards,
Tom Ogilvy



"woody334 " wrote in message
...
Thanks Tom. The reason I thought it was your code was due to the code
posted at http://contextures.com/xlautofilter03.html#Copy

The modification you provided works - although it tends to copy many
blank rows over as well.

I do know how many columns I need to copy and can extract the number of
rows. I just can't seem to create a range without VBA complaining.

I.E.
LastRow = Worksheets("TempView").Range("A65536").End(xlUp)
RangeText = "A1:S" & LastRow

I assume this is because LastRow is a number.

I am still open to ideas and suggestions.

many thanks !


---
Message posted from http://www.ExcelForum.com/

Copy Filtered Rows
 

see the correction I posted. It is still applicable and should correct the
error in the line you show.

LastRow = Worksheets("TempView").Range("A65536").End(xlUp).R ow
RangeText = "A1:S" & LastRow
Range(RangeText).Select


--
Regards,
Tom Ogilvy

"woody334 " wrote in message
...
Whoops .... it actually complains about a line I did not include in my
post...

I.E.
LastRow = Worksheets("TempView").Range("A65536").End(xlUp)
RangeText = "A1:S" & LastRow
Range(RangeText).Select

Again - thanks Tom.... and everyone else.


---
Message posted from http://www.ExcelForum.com/