複製3行並將它們粘貼在上面

Question

我試圖在列A中找到一個值〜P〜。複製它所在的行和下一個2。並粘貼行上面的所有3我發現〜P〜上。

我有這樣的：

Private Sub NPaddlinebutton_Click() 
    Dim i As Long 
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 
     If Range("A" & i).Value = "~P~" Then 
      Rows(i).Copy 
      Rows(i).Insert 
      Range("A" & i).ClearContents 
      Rows(i).Activate 
     End If 
    Next 
    Application.CutCopyMode = False 
End Sub 

它適用於1列，但無法弄清楚如何做到這一點的3行。 任何提示？

Answer 1

如果我確實明白你在找什麼，下面的代碼應該做。關鍵是要使用一個範圍來包含你想「玩」的東西。例如3行。 讓我知道。

Private Sub NPaddlinebutton_Click() 
    Dim i As Long 
    Dim rng3rows As Range 
    Dim rng3CellsColumn As Range 
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 
     If Range("A" & i).Value = "~P~" Then 
      Set rng3rows = Range(Rows(i), Rows(i + 2))' using a range to include the 3 rows you want to copy over 
      rng3rows.Copy 
      Rows(i).Insert 
      Set rng3CellsColumn = Range(Cells(i, 1), Cells(i + 2, 1))' using a range to clear the the cells in the column A 
      rng3CellsColumn.ClearContents 
      Rows(i).Activate 'here i suggest Rows(i).select. I think that's what you want 
     End If 
    Next 
    Application.CutCopyMode = False 
    Set rng3rows = Nothing 
    Set rng3CellsColumn = Nothing 
End Sub 

Answer 2

Private Sub Paddline_Click() 
Dim i As Long 
    Dim rng3rows As Range 
    Dim rng3CellsColumn As Range 
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 
     If Range("A" & i).Value = "~P~" Then 
      Set rng3rows = Range(Rows(i), Rows(i + 2)) 'using a range to include the 3 rows you want to copy over 
      rng3rows.Copy 
      Rows(i).Insert 
      Set rng3CellsColumn = Range(Cells(i, 1), Cells(i + 2, 1)) 'using a range to clear the the cells in the column A 
      rng3CellsColumn.ClearContents 
      Rows(i).Select 
     End If 
    Next 
    Application.CutCopyMode = False 
    Set rng3rows = Nothing 
    Set rng3CellsColumn = Nothing  
    'in randul 1 
    Cells(ActiveCell.Row, 2).Value = Pclient.Value 
    Cells(ActiveCell.Row, 3).Value = Pcodclient.Value 
    Cells(ActiveCell.Row, 4).Value = "" 
    Cells(ActiveCell.Row, 5).Value = Pnrcomanda.Value 
    Cells(ActiveCell.Row, 7).Value = Pdesc1.Value 
    Cells(ActiveCell.Row, 8).Value = Pperscontact.Value 
    Cells(ActiveCell.Row, 28).Value = Pstatus.Value  
    'in randul 2 
    Cells(ActiveCell.Row + 1, 2).Value = Pclient.Value 
    Cells(ActiveCell.Row + 1, 4).Value = "" 
    Cells(ActiveCell.Row + 1, 8).Value = Pdesc2.Value 
    Cells(ActiveCell.Row + 1, 10).Value = Pdurata.Value 
    Cells(ActiveCell.Row + 1, 11).Value = Pdatadelay.Value 
    Cells(ActiveCell.Row + 1, 27).Value = Pusername.Value 
    Cells(ActiveCell.Row + 1, 28).Value = Pstatus.Value  
    'in randul 3 
    Cells(ActiveCell.Row + 2, 2).Value = Pclient.Value 
    Cells(ActiveCell.Row + 2, 4).Value = "" 
    Cells(ActiveCell.Row + 2, 8).Value = Pdesc3.Value 
    Cells(ActiveCell.Row + 2, 10).Value = Pdurata.Value 
    Cells(ActiveCell.Row + 2, 27).Value = PusernameV.Value  
MsgBox "Datele au fost introduse in tabel." 
    ActiveWindow.ScrollRow = 56 
    Unload Me