Need Help with this macro

[hjason315]

Hi all,

This macro was made to find all values 20 steps before everytime it meets the first empty cells(after a bunch of filleds) in Column M. And I would like to copy all these values found and paste them on Column H in order. Can anyone help me simplify this code?

Also, This line/function
"Selection.Copy Destination:=Cells(i, 8)" doesn't really copy and paste, but cut and paste instead. I do not want to cut off any of the cells, can anyone help me to find out why this is happening?

 Dim i As Long, LastRow As Long
 
    LastRow = Range("B65536").End(xlUp).Row - 200
    If Not LastRow < 1 Then
    For i = 14 To LastRow
    If Not IsEmpty(Cells(i - 1, 13)) And IsEmpty(Cells(i, 13)) Then Cells(i - 20, 13).Select
    Selection.Copy Destination:=Cells(i, 8)
 
    Selection = ""
    Next i
    End If
 
    Columns("H:H").SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)
 
End Sub

 

[Scott Huish]

There's no need to Select but it is copying and pasting.
You are removing the values however in your code.

Remove this line:

Selection = ""

 

[Scott Huish]

Sub test()
On Error Resume Next
Dim i As Long, LastRow As Long
LastRow = Range("B" & Rows.Count).End(xlUp).Row - 200
If LastRow > 0 Then
    For i = 14 To LastRow
        If Cells(i - 1, 13) <> "" And Cells(i, 13) = "" Then Cells(i - 20, 13).Copy Cells(i, 8)
    Next i
End If
Range("H:H").SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
End Sub

 

[hjason315]

There's no need to Select but it is copying and pasting.
You are removing the values however in your code.

Remove this line:

Selection = ""

No, if I remove this line
Selection = ""

Then the macro will paste the value found in Col M all the way down as "i" is increasing.

 

[hjason315]

Sub test()
On Error Resume Next
Dim i As Long, LastRow As Long
LastRow = Range("B" & Rows.Count).End(xlUp).Row - 200
If LastRow > 0 Then
    For i = 14 To LastRow
        If Cells(i - 1, 13) <> "" And Cells(i, 13) = "" Then Cells(i - 20, 13).Copy Cells(i, 8)
    Next i
End If
Range("H:H").SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
End Sub

This code works perfect! Thank you so much.