VBA，将特定列转移到新工作表中

Question

我有下面的代码，如果学生延迟了，它会把学生转到另一个工作表上。如果硕士研究生的招生周期为132或更短，学士学生的招生周期为130或更短，则学生将被延迟。此代码复制所有标题，并在学生延迟时将所有列和数据转移到新工作表中。我只需要A，B，D，G，H，I，M列的数据，如果学生延迟了，我就把它放在A，B，C，D，E，F，G列的新工作表上。我该如何修改这段代码才能做到这一点呢？提前感谢！

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

Answer 1

目前，您在代码的这一部分中使用内置的复制粘贴方法复制整个行：

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

将其替换为像这样的值的单元格复制将是最容易的：

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

要设置正确的标头，请替换代码的这一部分：

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

通过以下方式：

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