Copying works when sheet is first blank but won't after that.

[Randy Reese]

This works when "Print282" sheet is empty, but second click should find the
end and append new data to the end. Can anyone help me?
_________________________________________________________
Private Sub btnProcess_Click()
Dim WS As Worksheet
Dim WS2 As Worksheet
Dim Str As String
Dim LRow As Long


Set WS = Sheets("lod")
Set WS2 = Sheets("Print282")
LRow = LastRow(WS2)
Str = "282"
Call Copy_With_AutoFilter(WS, WS2, Str, LRow)
End Sub
_____________________________________________________
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("B1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

On Error GoTo 0
End Function
____________________________________________________________________________
_________
Sub Copy_With_AutoFilter(WS As Worksheet, WS2 As Worksheet, Str As String,
LRow As Long)


With WS.Columns("b:b")
.AutoFilter Field:=1, Criteria1:=Str
WS.Range("D:F").Cells.SpecialCells(xlCellTypeVisible).Copy _
WS2.Range("B" & LRow + 1)

End With

WS.AutoFilterMode = False

End Sub
__________________________________________________

 

[Randy Reese]

It worked on a blank page not one that has stuff on it already.
I sent you a copy.

 

[Ron de Bruin]

Hi Randy

You got problems because you copy all Visible cells in the column

WS.Range("D:F").Cells.SpecialCells(xlCellTypeVisible).Copy

For example if you have run the sub the first time and copy 100 records
of the 1000 to Sheets("lod")
You are copy (65536-900 rows) to the sheet.
So if you run it the next time(or third ??) there are not enough rows to
copy to

Try this example that use the AutoFilter.Range
Post back if it is working the way you want

Sub test()
Dim rng As Range
Dim WS As Worksheet
Dim WS2 As Worksheet
Dim Str As String
Dim LRow As Long

Set WS = Sheets("lod")
Set WS2 = Sheets("Print282")
LRow = LastRow(WS2)
Str = "282"

With WS.Columns("B:F")
.AutoFilter Field:=1, Criteria1:=Str
With WS.AutoFilter.Range
On Error Resume Next
Set rng = .Offset(0, 2).Resize(.Rows.Count - 1, 3) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
rng.Copy WS2.Range("B" & LRow + 1)
End If
End With
End With
WS.AutoFilterMode = False
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("B1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

On Error GoTo 0
End Function