copy cells down

[Guest]

how can i create a loop macro that look for a data in a specific column, lets
say column B, select that cell, select 3 cells to the right, cut these
selection and move one row down. Continue the same procedure until there is
no more cells containing the data. Thanks for your help

 

[Jean-Yves]

Hi
This will search from bottom to top to any cell containg "ABC"

Sub test
Dim x As Integer
For x = Range("B2", Range("B2").End(xlDown)).Rows.Count - 1 To 1 Step -1
If Range("B2").Offset(x, 0) = "ABC" Then
Range("B2").Offset(x, 0).Resize(1, 4).Cut Range("B2").Offset(x + 1, 0)
End If
Next x
End sub
Regards
Jean-Yves

 

[Guest]

Hi
This will search from bottom to top to any cell containg "ABC"

Sub test
Dim x As Integer
For x = Range("B2", Range("B2").End(xlDown)).Rows.Count - 1 To 1 Step -1
If Range("B2").Offset(x, 0) = "ABC" Then
Range("B2").Offset(x, 0).Resize(1, 4).Cut Range("B2").Offset(x + 1, 0)
End If
Next x
End sub
Regards
Jean-Yves





i change ABC to 3020 and does not work, am i doing something wrong

 

[Guest]

let's say i have rows like these:
B C D E
3020 0 28TH 28TH ST. MARKETPLACE

3020 0 ACME ACME AWNING

The macro should find 3020, take cells in colums B C D E and bring them one
row down

 

[Jean-Yves]

Sub test
Dim x As Integer
For x = Range("B2", Range("B2").End(xlDown)).Rows.Count - 1 To 1 Step -1
If Range("B2").Offset(x, 0).value = "3020" Then
Range("B2").Offset(x, 0).Resize(1, 4).Cut Range("B2").Offset(x + 1, 0)
End If
Next x
End sub
Regards
Jean-Yves