Can I amend a macro to repeat with different rows

[ghrek]

Hi

I have this macro that moves data from column G when it contains specific requirements. What im trying to do is to repeat it so if column H contains the specific data then I need data from columns H & I into column BB and then if column I contains the data I need the data from I & J moving into BB and so on until I get to column Z.

Can this be done?


Dim ws As Worksheet
Dim lr As Long, i As Long

Application.ScreenUpdating = False

Set ws = Worksheets("Sheet 1") 'Data Sheet
lr = ws.Cells(Rows.Count, "G").End(xlUp).Row

For i = 1 To lr
If UCase(ws.Cells(i, "G").Value) = "Sale Number (SDCI+)" Then
ws.Range("G" & i & "H" & i).Cut ws.Range("BB" & i)
End If
Next i
Application.ScreenUpdating = True
'
End Sub

 

[Joe4]

Try this:

Sub MyCutAndPaste()

    Dim ws As Worksheet
    Dim lr As Long, i As Long
    Dim c As Long

    Application.ScreenUpdating = False

    Set ws = Worksheets("Sheet 1") 'Data Sheet
    
'   Specify columns to loop through, numerical (G=7, H=8, I=9,...)
    For c = 7 To 9
        lr = ws.Cells(Rows.Count, c).End(xlUp).Row

'       Loop through all rows in the column
        For i = 1 To lr
            If UCase(ws.Cells(i, c).Value) = "Sale Number (SDCI+)" Then
                ws.Range(Cells(i, c), Cells(i, c + 1)).Cut ws.Range("BB" & i)
            End If
        Next i
    Next c
    
    Application.ScreenUpdating = True

End Sub