在不同的工作表复制行 – 不同的行VBmacros

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

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 

 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