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

时间:2014-01-13 18:06:28

标签: vba excel-vba excel-2010 excel

我环顾了论坛,玩了各种各样的选项,但没有找到与我的问题明确的匹配:

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

下面的代码示例(前2个仅复制第一行,第3个示例是我尝试循环和复制多行的地方:

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

3 个答案:

答案 0 :(得分:2)

试试这个:

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

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

如果有帮助,请告诉我们。

答案 1 :(得分:1)

从我看到的情况来看,您只是在E列中复制单元格。您可以通过将Cells(xrow, 5).Copy替换为

来更正此问题
Union(Sheets("workorders").Cells(xrow,5),Sheets("workorders").Range(Cells(xrow,"P"),Cells(xrow,"S")).Copy

但是,使用SelectCopy并不理想。相反,您可以直接指定范围的值:

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

有关the Union methodwhy using Select is bad的更多信息。

答案 2 :(得分:0)

甚至可以像这样运行一条线路吗? 工作表(“工作单位”)。范围(“E2,P2:S2”)。复制

每次我尝试不同的方式来复制/选择包含在我的情况下的范围,A3和范围A34:C40(“A3,A34:C40”)。复制我得到一个错误,说明了许多参数..这可能是因为我正在运行Excel 2007吗?

任何提示或帮助都会受到极大的影响! :)