复制不同工作表中的行 - 不同的行VB宏

时间:2017-02-09 12:11:02

标签: excel vba excel-vba

我在电子表格中有三个工作表。我想从特定行复制到最后一个数据行并将它们粘贴到第二个,第三个工作表中(第二个,第三个 - 与第一个工作表不同的行号)

  Dim Source As Worksheet
    Dim Source As Worksheet
        Dim Target As Worksheet
        Dim Target1 As Worksheet

    Dim LastRow As Long
    Dim FirstRow2Copy As Long
        Dim FirstRowCQuote As Long
        Dim FirstRowIQuote As Long
    Dim CQFCell As Excel.Range
        Dim IQFCell As Excel.Range

        Set Source = ActiveWorkbook.Worksheets("myWorksheet1")
            Set Target = ActiveWorkbook.Worksheets("mysheet1")
            Set Target1 = ActiveWorkbook.Worksheets("mysheet2")


            With Source 'Worksheets("myWorksheet1") Last row
              LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row '.Cells(.Rows.Count, "A").End(xlUp).Row
             End With       

        Set FoundCell = ws.Range("A:A").Find(what:="Enter the Quantity items:", lookat:=xlWhole)
        If Not FoundCell Is Nothing Then        
            'Need to copy from this first row to last row
            FirstRow2Copy = FoundCell.Row + 1
        End If
Set CQuoteFCell = Target1.Range("A:A").Find(what:="Enter the Quantity items:", lookat:=xlWhole)
        If Not CQuoteFCell Is Nothing Then
    FirstRowCQuote = CQuoteFCell.Row + 1
    End If

    Set IQuoteFCell = Target1.Range("A:A").Find(what:="Enter the Quantity items:", lookat:=xlWhole)
        If Not IQuoteFCell Is Nothing Then
    FirstRowIQuote = IQuoteFCell.Row + 1
    End If

                'Need to copy rows from FirstRow2Copy untill LastRow - where paste them in Target sheet from RowNumber:FirstRowCQuote, 
                    'Paste the same rows in Target1 sheet from RowNumber:FirstRowIQuote

1 个答案:

答案 0 :(得分:0)

Dim FoundCell As Range, LastCell As Range
With Worksheets("myWorksheet1")
    Set FoundCell = .Range("A:A").Find(what:="Enter the Quantity items:", lookat:=xlWhole)
    If FoundCell Is Nothing Then Exit Sub
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    With .Range(FoundCell.Offset(1), LastCell).EntireRow
       .Copy Worksheets("mysheet1").Range("A:A").Find(what:="Enter the Quantity items:", lookat:=xlWhole).Offset(1)
       .Copy Worksheets("mysheet2").Range("A:A").Find(what:="Enter the Quantity items:", lookat:=xlWhole).Offset(1)
   End With
End With