复制3行并将它们粘贴在上面

我试图在列A中找到一个值〜P〜。复制它所在的行和下一个2。并粘贴行上面的所有3我发现〜P〜上。复制3行并将它们粘贴在上面

我有这样的：

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行。任何提示？

来源

2016-09-16 Andrei Mesaroș

如果我确实明白你在找什么，下面的代码应该做。关键是要使用一个范围来包含你想“玩”的东西。例如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

来源

2016-09-16 11:01:30 suisgrand

是的，我想选择该行，但是当我用ActiveRow后调用它，我得到的调试错误说ActiveRow =空 –

http://imgur.com/Xd65VRU –

尝试activecell.Row代替例如：单元格（activecell.Row，2）.value = Pclient.Value，根据您的代码 – suisgrand

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

来源

2016-09-16 12:03:48

欢迎你，男士。我很高兴你找到了解决方案的其他部分的代码！ – suisgrand

复制3行并将它们粘贴在上面

回答

相关问题