Help With VBA Copy Code

[CribbsStyle]

Im using this vba code to copy each row that has a certain value in it
to another sheet. What I want to know is how can I get it to not copy
and paste the entire row, just A through P, like A33.?

I call it by using this..

copyplayer "HidRatings", "PR Current", "12", "RB", "C", "2"


Sub copyplayer(ByVal copyfromname, copytoname, copytorow, position,
columnsearch, StartRow)
Application.ScreenUpdating = False
Dim LSearchRow As Integer
Dim LCopyToRow As Integer

LSearchRow = StartRow
LCopyToRow = copytorow

Sheets(copyfromname).Select
While Len(Range(columnsearch & CStr(LSearchRow)).Value) > 0
If Range(columnsearch & CStr(LSearchRow)).Value = position Then
Sheets(copyfromname).Rows(CStr(LSearchRow) & ":" &
CStr(LSearchRow)).Select
Selection.Copy

Sheets(copytoname).Select
Sheets(copytoname).Range(CStr(LCopyToRow) & ":" &
CStr(LCopyToRow)).PasteSpecial xlPasteValues
LCopyToRow = LCopyToRow + 1
Sheets(copyfromname).Select

End If

LSearchRow = LSearchRow + 1

Wend

Exit Sub

End Sub

Also is this the best code to use or is there some other code I can
use? Help would be greatly appreciated!

 

[JLGWhiz]

Try changing this from:

Sheets(copyfromname).Rows(CStr(LSearchRow) & ":" & _
CStr(LSearchRow)).Select

To:

Sheets(copyfromname).Range("A" & CStr(LSearchRow) & _
"" & CStr(LSearchRow)).Select

 

[Bernie Deitrick]

Change

Sheets(copyfromname).Rows(CStr(LSearchRow) & ":" &
CStr(LSearchRow)).Select
Selection.Copy

To

With Sheets(copyfromname)
Intersect(.Rows(LSearchRow), .Range("A")).Copy
End With

Also is this the best code to use or is there some other code I can
use? Help would be greatly appreciated!

You could simply filter the table to show the desired value in the key
column, and then copy the visible cells, so no looping would be involved,
and it would be LOTS faster. But a lot depends on your table structure - do
you know where the table is, which column has the values, is column A
filled, are there blank rows or columns, etc.

Also, you should get into the habit of

Dim LSearchRow As Long ' NOT Integer - your variable name starts with L
which usually implies Long....

Bernie

 

[CribbsStyle]

How would I go about filtering, and I need this to all happen behind
the scenes in VBA.

Yeah I know where the table is...

HidRatings.Range(A290)

Column C has the value Im searching for

Column is mostly filled...there are a few that are not filled, I could
just delete them.

No full blank rows or columns

 

[Bernie Deitrick]

To work with your previously posted style:

Sub test()
CopyPlayer "HidRatings", "PR Current", "12", "RB", "C", "2"
End Sub


Sub CopyPlayer(ByVal copyfromname As String, _
ByVal copytoname As String, _
ByVal copytorow As Long, _
ByVal position As String, _
ByVal columnsearch As String, _
ByVal StartRow As Long)

Dim myR As Range
With Worksheets(copyfromname)
.Range("A" & StartRow - 1).CurrentRegion.AutoFilter _
Field:=Cells(1, columnsearch).Column, Criteria1:="=" & position
Set myR = Intersect(.UsedRange, .Range("A" & StartRow & "" &
Rows.Count)) _
.SpecialCells(xlCellTypeVisible)
myR.Copy
End With
With Worksheets(copytoname)
.Range("A" & copytorow).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End Sub


HTH,
Bernie
MS Excel MVP

 

[carlo]

Hi Cribbsstyle

if you record such procedures, keep in mind, that Excel always works
with selection, which is first of all slow and second not needed.

try this:

Sub copyplayer(ByVal copyfromname, copytoname, copytorow, position,
columnsearch, StartRow)
Application.ScreenUpdating = False

Dim ShFrom As Worksheet
Dim ShTo As Worksheet
Dim LSearchRow As Integer
Dim LEndRow As Integer
Dim LCopyToRow As Integer
Dim cell_ As Range

Set ShFrom = Sheets(copyfromname)
Set ShTo = Sheets(copytoname)
LCopyToRow = copytorow
LEndRow = ShFrom.Cells(65536, columnsearch).End(xlUp).Row

For Each cell_ In ShFrom.Range(ShFrom.Cells(StartRow, columnsearch),
ShFrom.Cells(LEndRow, columnsearch))
If cell_.Value = position Then
ShFrom.Range("A" & cell_.Row & ":B" & cell_.Row).Copy
ShTo.Range("A" & LCopyToRow).PasteSpecial xlPasteValues
LCopyToRow = LCopyToRow + 1
End If
Next cell_

Application.ScreenUpdating = True
End Sub

hope you understand what i did, otherwise just ask.

cheers

Carlo

PS: Be careful there will be some wordwraps!!!

 

[CribbsStyle]

Bernie..Thanks worked PERFECTLY and is ALOT FASTER!