Need Help On Macro

[niladri20052006]

Hi All,

I have 2024 data in an shhet1. But some data are marked as 2 in Column A and some data as 1. for Example in A1 it is 2 then starts with all other info in B1, C1...and so on and in A2 1 then starts with other info

I want the the same data where it is marked as 2. for example if in cell A1 the data is marked as 2, then it will copy the data and paste under it. I want the same data for 2 times and 1 will be remain unchanged..

i tried a code the following one but it not working

Range("A1").Select
    Sheets("Sheet1").Select
    Rows("2:2").Select
    Selection.Copy
    Rows("3:3").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    ActiveWorkbook.Save

i can understand the code has copied rows 2 data and pasted under it. my question is that will have to write it again and again?

Please suuggest

 

[JoeMo]

Hi All,

I have 2024 data in an shhet1. But some data are marked as 2 in Column A and some data as 1. for Example in A1 it is 2 then starts with all other info in B1, C1...and so on and in A2 1 then starts with other info

I want the the same data where it is marked as 2. for example if in cell A1 the data is marked as 2, then it will copy the data and paste under it. I want the same data for 2 times and 1 will be remain unchanged..

i tried a code the following one but it not working

Range("A1").Select
    Sheets("Sheet1").Select
    Rows("2:2").Select
    Selection.Copy
    Rows("3:3").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    ActiveWorkbook.Save

i can understand the code has copied rows 2 data and pasted under it. my question is that will have to write it again and again?

Please suuggest

Try this. Assumes row 1 is a header row and there are no empty rows between the header row and the end of your data.

Sub DupIf2()
Dim R As Range, vA As Variant
Application.ScreenUpdating = False
'Assuming first row is a header row
Set R = Range("A1").CurrentRegion
Set R = R.Offset(1, 0).Resize(R.Rows.Count - 1)
vA = R.Value
For i = UBound(vA, 1) To LBound(vA, 1) Step -1
    If vA(i, 1) = 2 Then
        With R.Rows(i)
            .Insert
            .Copy Destination:=.Offset(-1, 0)
        End With
    End If
    Application.CutCopyMode = False
Next i
End Sub

 

[drsarao]

You need to use a loop.
Try this:
(on a copy please)

Sub Duplicate2s()
lr = Cells(Rows.Count, "A").End(xlUp).Row 'last row in column A
For r = 1 To lr * 2
    If Cells(r, "A") = 2 Then
        Rows(r + 1).Insert
        Rows(r).Copy Destination:=Rows(r + 1)
        r = r + 1
    End If
Next r
End Sub