Copy Filtered Rows

[woody334]

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

 

[Tom Ogilvy]

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

 

[woody334]

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

 

[woody334]

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

 

[Tom Ogilvy]

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).Row
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.

 

[Tom Ogilvy]

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).Row
RangeText = "A1:S" & LastRow
Range(RangeText).Select