CODEWITHSUNDEEP
vbaexcel
Chris TJ
Chris TJ

Reputation: 53

VBA, Transfer specific columns over to a new sheet

I have the following code that transfers a student over to another sheet if the student is delayed. The student is delayed if enroll-period is 132 or less for a master's student and 130 and less for a bachelor student. This code copys all of the headers and takes all of the columns and data over to the new sheet if the student is delayed. I only need the data from columns A, B, D, G, H, I, M and put it over in the new sheet in columns A, B, C, D, E, F, G, if the student is delayed. How should i change this code so it will do that? Thanks in advance! 

Sub findDelayedStudents()

Dim wsIn As Worksheet
Dim wsOut As Worksheet


Set wsIn = ThisWorkbook.Worksheets("Base")
Set wsOut = ThisWorkbook.Worksheets("Delayed Students")


wsOut.Cells.ClearContents
wsIn.Rows(1).Copy Destination:=wsOut.Range("A1")

Dim lLastInputRow As Long
Dim lCurrentInputRow As Long
Dim lCurrentOutputRow As Long


lLastInputRow = wsIn.Cells(wsIn.Rows.Count, 1).End(xlUp).Row
lCurrentOutputRow = 2


For lCurrentInputRow = lLastInputRow To 2 Step -1

If (wsIn.Cells(lCurrentInputRow, 10) = "B" And wsIn.Cells(lCurrentInputRow, 
5).Value <= 130) Or _
    (wsIn.Cells(lCurrentInputRow, 10) = "M" And wsIn.Cells(lCurrentInputRow, 
5).Value <= 132) Then


    wsIn.Rows(lCurrentInputRow).Copy 
Destination:=wsOut.Cells(lCurrentOutputRow, 1)
    lCurrentOutputRow = lCurrentOutputRow + 1
End If
Next lCurrentInputRow

wsIn.Range("A1").Select
Set wsIn = Nothing
Set wsOut = Nothing

End Sub

Upvotes: 0

Views: 84

Answers (1)

Luuklag
Luuklag

Reputation: 3914

Currently you copy over entire rows using the inbuild copy paste methods in this part of your code:

wsIn.Rows(lCurrentInputRow).Copy 
Destination:=wsOut.Cells(lCurrentOutputRow, 1)
lCurrentOutputRow = lCurrentOutputRow + 1

It would be easiest to replace that with cell wise replication of your values like such:

wsOut.Cells(lCurrentOutputRow,1) = wsIn.Cells(lCurrentInputRow,1) 'A to A
wsOut.Cells(lCurrentOutputRow,2) = wsIn.Cells(lCurrentInputRow,2) 'B to B
wsOut.Cells(lCurrentOutputRow,3) = wsIn.Cells(lCurrentInputRow,4) 'D to C
wsOut.Cells(lCurrentOutputRow,4) = wsIn.Cells(lCurrentInputRow,7) 'G to D
wsOut.Cells(lCurrentOutputRow,5) = wsIn.Cells(lCurrentInputRow,8) 'H to E
wsOut.Cells(lCurrentOutputRow,6) = wsIn.Cells(lCurrentInputRow,9) 'I to F
wsOut.Cells(lCurrentOutputRow,7) = wsIn.Cells(lCurrentInputRow,13) 'M to G
lCurrentOutputRow = lCurrentOutputRow + 1

To set the correct headers replace this part of your code:

wsIn.Rows(1).Copy Destination:=wsOut.Range("A1")

With:

wsOut.Cells(1,1) = wsIn.Cells(1,1) 'A to A
wsOut.Cells(1,2) = wsIn.Cells(1,2) 'B to B
wsOut.Cells(1,3) = wsIn.Cells(1,4) 'D to C
wsOut.Cells(1,4) = wsIn.Cells(1,7) 'G to D
wsOut.Cells(1,5) = wsIn.Cells(1,8) 'H to E
wsOut.Cells(1,6) = wsIn.Cells(1,9) 'I to F
wsOut.Cells(1,7) = wsIn.Cells(1,13) 'M to G

Upvotes: 2

Related Questions