Macro to run on entire data on the sheet

[theprincesunil]

Dear Team,

I have made the macro. But it runs only one time and it is stopping. I am very sure that we have to use some decision making tool but not able to do and succeed. Please find the attached file and below code.

Sub Datamodi()
Range("AN7").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(2, -31).Select
Range(ActiveCell, ActiveCell.Offset(0, -7)).Copy
ActiveCell.Offset(-1, 25).PasteSpecial Paste:=xlPasteValues
Rows(ActiveCell.Offset(1, 0).Row).Delete
End Sub

[arlu1201]

You have not specified any loop, hence its doing it only once.

Maybe if you explain what you are trying to accomplish, it will make it easier for us to help you.

[theprincesunil]

Hi,
Thanks for reply. In the data sheet, Eg for row:It has to copy the data between B599 to I599 after that it has to paste at AH598:AO598. Later, Entire 599 row has to be deleted.Like that it has to do for 601,603....where ever data corrupted.

[arlu1201]

You mean every alternate row should be copied one row higher in columns AH:AO?

[theprincesunil]

For easy reference,
I intially write the below code

Sub sdhf()
Range("AN7").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(2, 0).Select
ActiveCell.End(xlToLeft).Select
Range(ActiveCell, ActiveCell.Offset(0, -7)).Copy
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("AG7").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(1, 0).Select
Rows(ActiveCell.Row).Delete
End Sub

[theprincesunil]

Yes u are right but only where data is crushed and gone to next line. till 597 rows, data came from apps correct. After that one row been added and AH598:AO598 Cells moved to next line at 599. this way, some cells will be moved to next line.

[arlu1201]

Try this code - I have specified that it should start from row 599. You can change that if your real data has some other row with the misplaced info -

Sub sync_rows()
Dim i As Long, lrow As Long

Application.ScreenUpdating = False

With Worksheets("Sheet1")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = lrow To 599 Step -1
        .Range("B" & i & ":I" & i).Copy .Range("AH" & i - 1)
        .Rows(i).Delete
        i = i - 1
    Next i
End With

Application.ScreenUpdating = True

End Sub