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

Copy multiple rows from one worksheet to another worksheet using macro/vba

提问by dan1974

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

我环顾了论坛并尝试了各种选项，但没有找到适合我的问题的明确匹配项：

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.

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

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

下面的代码示例（前 2 个仅复制第一行，第三个示例是我尝试循环和复制多行的地方：

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

采纳答案by Jerome Montino

Try this:

尝试这个：

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

Read the comments first and test.

首先阅读评论并进行测试。

Let us know if this helps.

如果这有帮助，请告诉我们。

回答by thunderblaster

From what I see, you are only copying the cell in Column E. You could correct this by replacing Cells(xrow, 5).Copywith

从我所见，您只是在复制 E 列中的单元格。您可以通过替换Cells(xrow, 5).Copy为

Union(Sheets("workorders").Cells(xrow,5),Sheets("workorders").Range(Cells(xrow,"P"),Cells(xrow,"S")).Copy

However, using Selectand Copyare not ideal. Instead, you can assign the value of the range directly:

但是，使用Select和Copy并不理想。相反，您可以直接分配范围的值：

Sheets("Assignments DC").Range("A4").Value = Union(Sheets("workorders").Cells(xrow,5),Sheets("workorders").Range(Cells(xrow,"P"),Cells(xrow,"S")).Value

More info on the Union methodand why using Select is bad.

有关Union 方法以及为什么使用 Select 不好的更多信息。

回答by haakonlu

Is it even possible to run a line like this? Worksheets("workorders").Range("E2, P2:S2").Copy

甚至有可能运行这样的线路吗？工作表（“工作订单”）。范围（“E2，P2：S2”）。复制

Each time I try different ways to copy/select a range which contains in my case, A3 and the range A34:C40 ("A3, A34:C40").Copy i get an error saying theres to many parameters.. Could this be because I'm running excel 2007?

每次我尝试不同的方法来复制/选择一个范围，其中包含在我的情况下，A3 和范围 A34:C40（“A3，A34:C40”）。复制我得到一个错误，说有很多参数......这可能是因为我正在运行 excel 2007？

Any tips or help would be greatly apreciated! :)

任何提示或帮助将不胜感激！:)