Kopieren Sie 3 Zeilen und fügen Sie sie über

Question

ein

Ich versuche, einen Wert ~ P ~ in Spalte A zu finden. Kopieren Sie die Zeile, die es ist, und die 2 nächsten. Und füge alle 3 oberhalb der Zeile ein, in der ich ~ P ~ gefunden habe.

Ich habe dies:

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 

Es funktioniert für 1 Zeile, kann aber nicht herausfinden, wie es für 3 Reihen zu tun. Irgendwelche Tipps?

Answer 1

Wenn ich klar verstanden habe, was Sie suchen, sollte der folgende Code tun. Der Schlüssel ist, einen Bereich zu verwenden, mit dem Sie "spielen" möchten. 3 Zeilen zum Beispiel. Lass es mich wissen.

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