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

问题描述

我已经看过这个论坛，玩了各种各样的选项，但没有找到一个明确的匹配我的问题：

I've looked around the forum and played with various options but not found a clear match for my problem:

我的任务是从工作表复制数据称为作业）到第二个工作表（称为作业）。要复制的数据来自cell工作表，从单元格范围E2，P2：S2开始;并且还从每行（相同范围）复制直到列P为空 - （每次需要运行此宏时，要复制的行数可能会有所不同，因此我们无法选择标准范围）。然后粘贴到作业工作表中，从单元格A4开始。到目前为止，我已经使用了这个论坛来成功地复制一行日期（从第2行） - 我承认这是很简单的部分，我已经使用各种版本的代码来实现这一点。
我也尝试过一些代码（我通过观看一个YouTube剪辑和修改），让我运行一个循环，该循环重复workorders工作表中每个必需行的复制过程，然后将数据粘贴到赋值工作表 - 但这是我没有得到正确的地方，我认为我是正确的，认为我不远，但任何帮助将是非常有用的。

My task is to copy data from a worksheet (called "workorders") to a second worksheet (called "Assignments"). The data to be copied is from the "workorders" worksheet starting at cell range "E2, P2:S2"; and also copied from each row (same range) until column "P" is empty – (the number of rows to be copied can vary each time we need to run this macro so we can’t select a standard range) . Then pasted into the "Assignments" worksheet, starting at cell "A4". I’ve used the forum so far to successfully copy a single row of date (from row 2) – I admit that’s the easy part, and I’ve used various versions of code to achieve this.I’ve also tried some code (which I found via watching a youtube clip and modifying http://www.youtube.com/watch?v=PyNWL0DXXtQ )to allow me to run a loop which repeats the copy process for each required row in the "workorders" worksheet and then pastes the data into the "assignments" worksheet- but this is where I am not getting it right, I think I’m along the right lines and think I’m not far off but any help would be very useful.

下面的代码示例（前2个只复制第一行，第3个例子是我试图循环和复制多个行：

Code examples below (first 2 only copy first row, 3rd example is where I’ve tried to loop and copy multiple rows:

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

推荐答案

尝试这是：

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

首先阅读评论并测试。

让我们知道这是否有帮助。

Let us know if this helps.

这篇关于使用宏/ vba将多个行从一个工作表复制到另一个工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！