Copy and paste above found row

[silentwolf]

Hi guys,

I like to copy an entire row and paste that row above found row if condition is met.

this is what I got so far but how do I need to ad the paste line into that code?

Sub InsertCopiedRowAboveNumerberOne()
    Dim lngZeile As Long
    Dim lngZeileMax As Long
    
    With ActiveSheet
        lngZeileMax = .UsedRange.Rows.Count
        For lngZeile = lngZeileMax To 2 Step -1
            If .Cells(lngZeile, 7).Value = 1 Then
            
                .Cells.EntireRow.Copy
                
                .Rows(lngZeile).EntireRow.Insert
                
            End If
        Next lngZeile
    End With
End Sub

so i like to find the number 1 in column G and copy that row above that row.

Idealy I like to change the value of the call in column C to 156 and the rest of the row values should stay the same.

Many thanks for your help!!

Cheers Albert

 

[Snakehips]

@silentwolf

.Cells.EntireRow.Copy is trying to copy the whole sheet.

Maybe like....

Sub InsertCopiedRowAboveNumerberOne()    Dim lngZeile As Long
    Dim lngZeileMax As Long
Application.ScreenUpdating = False
    With ActiveSheet
        lngZeileMax = .UsedRange.Rows.Count
        For lngZeile = lngZeileMax To 2 Step -1
            If .Cells(lngZeile, 7).Value = 1 Then
            
            '*** Move line to here if both C cells to be 156
                .Cells(lngZeile, 7).EntireRow.Copy
                
                .Rows(lngZeile).EntireRow.Insert
                
                .Cells(lngZeile, 3) = 156  'Move if both cells to be 156***
                
                
            End If
        Next lngZeile
    End With
    
    Application.CutCopyMode = False
   Application.ScreenUpdating = True
 
End Sub

Hope that helps.

 

[silentwolf]

Hi Tony,

many thanks to you it works fantastic!