Insert Row and Copy Down 300 times
Results 1 to 4 of 4

Thread: Insert Row and Copy Down 300 times
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Jul 2019
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Insert Row and Copy Down 300 times

    Hello, I've been searching with no success. I have 300 rows of data and I'd like to insert 7 new rows between each data point, copy that data point down those new rows, then move to the next data point. This will be done 300 times until I have 2,400 rows of each data point copied 8 times. Any help would be greatly appreciated.

    Thanks
    DTB

  2. #2
    New Member
    Join Date
    Jul 2019
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert Row and Copy Down 300 times

    I ended up building it out. It wasn't perfect, but it worked.

    Sub CopyDown()

    '
    Range(ActiveCell.Offset(1), ActiveCell.Offset(7)).Select
    Selection.EntireRow.Insert
    Range(ActiveCell.Offset(-1), ActiveCell.Offset(6, 1)).Select
    Selection.FillDown
    Range(ActiveCell.Offset(8), ActiveCell.Offset(8)).Select
    End Sub

    Assigned it a shortcut and ran it 300 times.

  3. #3
    New Member
    Join Date
    Jul 2019
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert Row and Copy Down 300 times

    Just thought about it, added a repeat macro to it and made cell C1 300.

    Sub Macro2()

    Dim i as Long
    For i=1 to Range("C1").Value
    CopyDown
    Next i

    End Sub

  4. #4
    Board Regular
    Join Date
    Sep 2004
    Posts
    1,353
    Post Thanks / Like
    Mentioned
    9 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Insert Row and Copy Down 300 times

    From the last used row up to the first row.
    Code:
    Sub Maybe()
    Dim i As Long, lc As Long
    Application.ScreenUpdating = False
    lc = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
            With Cells(i, 1).Resize(, lc)
                .Copy
                .Resize(7).Insert Shift:=xlDown
            End With
        Next i
    Application.ScreenUpdating = True
    End Sub
    There are people who work a lot and make many mistakes. There are people who work a little and make few mistakes. I know people who don't make any mistakes.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •