Copy Cell and Move to Another Cell (Offset) - VBA

2019-09-18 09:05发布

I have a column that has many blanks and entries. I want to take the entries (ignoring the blanks) and move them over to the right once and down twice replacing the contents. I have a feeling you would use the offset function, however I don't know how to write this in VBA. I've only used offset as a formula. Any help would be appreciated...

2条回答
时光不老,我们不散
2楼-- · 2019-09-18 09:50

First you need to create a loop, that moves through all the values of your range. There many ways to create loops, but here is one example:

'find last row of range
lastrow = ActiveSheet.UsedRange.Rows.Count

'Loops through the values from 2 to the last row of range
For x=2 to lastrow 

Next x

Then I recommend to loop through the range and check each cell value for your criteria using the IF function:

'Checks for blank value in column A. If not blank  
If Cells(x, 1).Value <> "" then
'Do Something
End IF

Now in order to copy all values in a new range, just set the values of the old and new cell equal:

'Moves value from column A to column B and two cells down
Cells(x+2, 2).Value = Cells(x, 1).Value

In summary your code would look something like this:

Sub MoveValue ()

lastrow = ActiveSheet.UsedRange.Rows.Count

For x=2 to lastrow 
    If Cells(x, 1).Value <> "" then
      Cells(x+2, 2).Value = Cells(x, 1).Value
    End IF
Next x

End Sub
查看更多
Anthone
3楼-- · 2019-09-18 10:03

here's a one liner:

Range("A:A").SpecialCells(xlCellTypeConstants).Offset(2, 1).FormulaR1C1 = "=R[-2]C[-1]" '<--| change "A:A" to actual column index

or, should your "not blank" cells derive from formulas in the cells:

Range("A:A").SpecialCells(xlCellTypeFormulas).Offset(2, 1).FormulaR1C1 = "=R[-2]C[-1]"
查看更多
登录 后发表回答