vba - 使用宏/vba 将多行从一个工作表复制到另一工作表

Question

我浏览了论坛并尝试了各种选项，但没有找到与我的问题完全匹配的选项:

我的任务是将数据从工作表(称为“工作订单”)复制到第二个工作表(称为“作业”)。要复制的数据来自“工作订单”工作表，从单元格范围“E2，P2:S2”开始；并且还从每一行(相同范围)复制，直到“P”列为空 - (每次我们需要运行此宏时要复制的行数可能会有所不同，因此我们无法选择标准范围)。然后粘贴到“作业”工作表中，从单元格“A4”开始。到目前为止，我已经使用论坛成功复制了一行日期(从第 2 行开始)——我承认这是最简单的部分，并且我已经使用了各种版本的代码来实现这一点。 我还尝试了一些代码(我通过观看 YouTube 剪辑并修改 http://www.youtube.com/watch?v=PyNWL0DXXtQ 找到的)，以允许我运行一个循环，该循环对“workorders”工作表中的每个所需行重复复制过程，然后将数据粘贴到“作业”工作表 - 但这是我做得不对的地方，我认为我走的是正确的路线，并且认为我离目标不远，但任何帮助都会非常有用。

下面的代码示例(前两个仅复制第一行，第三个示例是我尝试循环并复制多行的地方:

Sub CopyTest1()
' CopyTest1 Macro
'copy data from workorders sheet
'Worksheets("workorders").Range("E2,P2,Q2,R2,S2").Copy
Worksheets("workorders").Range("E2, P2:S2").Copy
'paste data to assignments sheet
'sheets("assigments dc").Range("A4").Paste
Sheets("Assigments DC").Select
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub




Sub CopyTest2()
Sheets("workorders").Range("e2,p2,q2,r2,s2").Copy Sheets("assigments dc").Range("a4")
End Sub


Sub CopyTest3()
Dim xrow As Long
'Dim xrow As String
xrow = 2
Worksheets("workorders").Select
Dim lastrow As Long
lastrow = Cells(Rows.Count, 16).End(xlUp).Row
Do Until xrow = lastrow + 1
ActiveSheet.Cells(xrow, 16).Select
If ActiveCell.Text = Not Null Then
'Range("E2,P2,Q2,R2,S2").Copy
'Selection = Range("E2,P2,Q2,R2,S2").Copy
'Cells(xrow, 5).Copy
Cells(xrow, 5).Copy
Sheets("Assigments DC").Select
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("workorders").Select
End If
xrow = xrow + 1
Loop
End Sub

Answer 1

试试这个:

Sub LoopCopy()

    Dim shWO As Worksheet, shAss As Worksheet
    Dim WOLastRow As Long, Iter As Long
    Dim RngToCopy As Range, RngToPaste As Range

    With ThisWorkbook
        Set shWO = .Sheets("Workorders") 'Modify as necessary.
        Set shAss = .Sheets("Assignments") 'Modify as necessary.
    End With

    'Get the row index of the last populated row in column P.
    'Change accordingly if you want to use another column as basis.
    'Two versions of getting the last row are provided.
    WOLastRow = shWO.Range("P2").End(xlDown).Row
    'WOLastRow = shWO.Range("P" & Rows.Count).End(xlUp).Row

    For Iter = 2 to WOLastRow
        Set RngToPaste = shAss.Range("A" & (Iter + 2))
        With shWO
            Set RngToCopy = Union(.Range("E" & Iter), .Range("P" & Iter & ":S" & Iter))
            RngToCopy.Copy RngToPaste
        End With
    Next Iter

End Sub

先阅读评论并测试。

请告诉我们这是否有帮助。