Need Help Copying Only Some Cells in VBA

[SilverSlug]

I'm working on a code in VBA to copy rows from sheet "ALL FILES" and paste them into "VIEW STUDENT" based on "JOHN SMITH". Right now it copies the entire row, but I only want to select columns D, E, H-AB (4, 5, 8-28) in the same row. Any ideas?

Sub RunMain()

Dim r As Long, endRow As Long, pasteRowIndex As Long
   
    Sheets("ALL FILES").Select

endRow = 50
pasteRowIndex = 1

For r = 1 To endRow 

    If Cells(r, Columns("B").Column).Value = "JOHN SMITH" Then 'Found



'I BELIEVE THAT THIS CODE NEEDS TO BE CHANGED...
            'Copy the current row
            Rows(r).Select
            Selection.Copy
            



           Sheets("view students").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Paste

            'Next time you find a match, it will be pasted in a new row
            pasteRowIndex = pasteRowIndex + 1

           'Switch back to your table & continue to search for your criteria
            Sheets("ALL FILES").Select
    End If

Next r
 'REVET TO VIEW NORMAL SHEET AGAIN
   Worksheets("view students").Activate
   
  'CLEAR CLIPBOARD
   Application.CutCopyMode = False
   
   'ADDS BLANK ROWS TO TOP OF CHART
       Rows("1:1").Select
    Range("B1").Activate


End Sub

I also need to edit the code so it searches for the value of a ListBox. Any ideas?

 

[tlowry]

Here is some code that may help you.

I suggest you try to stay away from "Select" and "Activate"

Also, specify which sheet you are referencing.

Let me know how it works for you...

Sub main()
    CopyRow "John Smith"
End Sub
Function GetRowFor(sName) As Long
    GetRowFor = 0
    Dim r As Long, rng As Range, fnd As Range
    [B]With Sheets("ALL FILES")[/B]
        Set rng = .Range("A1").CurrentRegion.Offset(1, 0)
        Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count)
        Set fnd = rng.Find(What:=sName, LookIn:=xlConstants, Lookat:=xlPart, MatchCase:=False)
        If Not fnd Is Nothing Then GetRowFor = fnd.Row
    End With
End Function
Sub CopyRow(sName)
    Dim lrow
    lrow = GetRowFor(sName)
    Select Case lrow
        Case 0
            MsgBox "Could not find"
        Case Else
        [B]Sheets("All Files")[/B].Rows(lrow).Copy
        [B]Sheets("view students")[/B].Rows(1).Insert
        Application.CutCopyMode = False
    End Select
End Sub

 

[SilverSlug]

tlorwy, thanks for the help!
all I get is:

Runtime '1004' error
Application-defined or object-defined error

the debugger takes me to the code

Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count)

I'm still pretty new at this so it may be a newbie mistake I made running it.

Thanks again for the help.

 

[tlowry]

I'm suspecting a difference in our data.

• I have 1 header row (row 1)
• Upper left hand corner of data is cell A1
• Names are in col A

ALL FILES

*	A	B	C
1	Name	Rank	SN
2	ralph	6	45
3	john Smith	2	46
4	F Smith	11	44

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4