Select a range based on number next to range

Hello, I'm a novice VBA user, and have a macro that I want to tweak, because there's an operation within the macro that can take a ton of time with large files. I'm trying to copy and paste a range of cells, and I'm using a Do Until ... Loop right now.

At this point in the macro, I have a list of SSN's in column H, starting with cell H7, and next to each one, in column I, there is a number indicating how many funds each SSN holds in their portfolio. The list has been sorted by #funds, so all the "1" fund SSN's are at the top. These are the SSN's I want to copy and paste in Column N.

So, to recap: the list of SSN's starts in cell H7, and the list of #funds starts in cell I7. This is what I wrote:

ActiveCell.Offset(1, -6).Range("A1").Select  [this step selects cell I7, which is always the beginning of the list in the #fund column]
    Do Until ActiveCell.Value > 1
        ActiveCell.Offset(0, -1).Range("A1").Select
        Selection.Copy
        ActiveCell.Offset(0, 6).Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(1, -5).Range("A1").Select
    Loop

So it's looking at the cell in column I, and if it's a "1", it copies the SSN next to it in column H, and pastes it into column N. Then it goes to the next cell in column I, etc. I'm copying and pasting each SSN one at a time.

Can anyone suggest a way for the macro to select all the SSN's with a "1" next to them, and copy/paste in one grand maneuver?

Thank you so much!!!! Jake