Page 1 of 2 12 LastLast
Results 1 to 15 of 17

Thread: Repeat copy

  1. #1
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    543
    Thanks
    56
    Thanked 0 Times in 0 Posts

    Repeat copy

    Can anyone advise me on how I can repeat a copy based on locating the next blank cell in a column.
    I currently use some code based around Ctrl+down and starting in cell "R2C5" to locate cell before blank, copy that cell contents down to the blank cell find next blank etc.etc.

    Application.Goto Reference:="R2C5"
    Selection.End(xlDown).Select

    Selection.End(xlDown).Select
    Selection.Copy
    Range("E7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    I am not very confident in setting variables and creating loops until done
    cheers

    Phil Carter

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    bonriki

    Try this for a one-time paste:
    Code:
    Public Sub CopyBlock()
    Cells(ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row, 5).Select 'FIND LAST ROW
    Cells(ActiveSheet.Cells(ActiveCell.Row, 5).End(xlUp).Row, 5).Select 'FIND PREVIOUS
    AvailableRow = ActiveCell.End(xlDown).Row
    Range(Cells(ActiveCell.Row, 5), Cells(AvailableRow, 5)).Select 'SELECT RANGE
    Selection.Copy
    Cells(AvailableRow + 1, 5).Select 'SELECT NEXT AVAILABLE ROW
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End Sub
    If you re-run the code, it will copy both consecutive blocks and paste with a result of a total of 4 blocks.

    If you want to repeatedly paste the same data (one block) at the next blank then use this code:
    Code:
    Public Sub RepeatCopy()
    Cells(ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row, 5).Select  'FIND LAST ROW
    If Application.CutCopyMode = 1 Then GoTo Skip 'IF THERE IS COPIED DATA ON CLIP BOARD
    Cells(ActiveSheet.Cells(ActiveCell.Row, 5).End(xlUp).Row, 5).Select 'FIND PREVIOUS
    AvailableRow = ActiveCell.End(xlDown).Row
    Range(Cells(ActiveCell.Row, 5), Cells(AvailableRow, 5)).Select 'SELECT RANGE
    Selection.Copy
    Cells(AvailableRow + 1, 5).Select 'SELECT NEXT AVAILABLE ROW
    Skip:
    ActiveSheet.Paste
    End Sub
    Attached Files Attached Files
    Last edited by Maudibe; 2013-11-12 at 22:24.

  3. #3
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    543
    Thanks
    56
    Thanked 0 Times in 0 Posts
    Maud hi
    Not quite what I wanted
    In column E(5) starting at E3, seek next empty cell, move up 1 row, copy, move down 1 row, paste. Repeat until no more
    cheers

    Phil Carter

  4. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Fill in the blank cells with the value above it? if so, then here you go.

    Code:
    Public Sub CopyRow()
    LastRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row + 1
    [e2].Select
    Repeat:
    AvailableRow = ActiveCell.End(xlDown).Row
    Cells(AvailableRow, 5).Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    If ActiveCell.Row = LastRow Then Exit Sub
    GoTo Repeat
    End Sub

  5. The Following User Says Thank You to Maudibe For This Useful Post:

    bonriki (2013-11-13)

  6. #5
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    543
    Thanks
    56
    Thanked 0 Times in 0 Posts
    Thanks again Maude
    This works for all but the last block.

    The code fails at this line; "ActiveCell.Offset(1, 0).Select", and leaves the cursor in the very last cell in that column flashing and waiting for a command.

    mmmmm a bit puzzling
    cheers

    Phil Carter

  7. #6
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    That just means you have the cell copied to the clipboard to dotted lines enter the code:
    Application.CutCopyMode=False

    Which gets you out of Copy Mode

    Steve

  8. #7
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    543
    Thanks
    56
    Thanked 0 Times in 0 Posts
    Steve thanks for that
    It's not the being in clipboard copy mode that's the problem. The code should have moved down to the next empty cell in the column. Excel, as usual, moves right to the end and then back up to the cell below the next with data but this is not happening and the code stalls waiting to move to the next cell down
    cheers

    Phil Carter

  9. #8
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Are you looking for somethin like:
    Code:
    Option Explicit
    Public Sub CopyBlock()
      Dim lLastRow As Long
      lLastRow = Cells(Rows.Count, 5).End(xlUp).Row
      Range("E2:E" & lLastRow).Copy Range("E" & lLastRow + 1)
    End Sub
    Steve

  10. #9
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    543
    Thanks
    56
    Thanked 0 Times in 0 Posts
    Steve
    Not really. We data exported from our CRM as per:
    ExtraProg.JPG

    What is required is to copy the last cell with the prog code in "E" down to the next blank cell in "E". Works fine for all except the last where the code goes to the last cell in column "E" and then tries to paste to the next cell down!
    I have tried all sorts of ways to get the code to check whether it is in the last cell of the column but to no avail.
    cheers

    Phil Carter

  11. #10
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Are you trying to fill all the blank rows?You don't need code for that.
    Select Column E
    Find & Select - Goto Special...
    Select "Blanks" [ok]
    in E2 enter:
    =E1
    confirm with ctrl-enter
    Select column E
    Copy
    Paste special -values


    If that is not what you want could you attach an example sheet with a before and after?
    Steve
    PS. The code for the filling in the blanks would be:
    Code:
    Sub FillBlanks()
      Columns("E:E").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
      Columns("E:E").Copy
      Range("E1").PasteSpecial Paste:=xlPasteValues
      Application.CutCopyMode = False
    End Sub
    Last edited by sdckapr; 2013-11-13 at 18:17. Reason: Added PS with code

  12. #11
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    The code fails at this line; "ActiveCell.Offset(1, 0).Select", and leaves the cursor in the very last cell in that column flashing and waiting for a command.
    Bonriki,

    If the code fails at any line, it will not be waiting for any commands. It is in debug mode.

    What is required is to copy the last cell with the prog code in "E" down to the next blank cell in "E".
    Works fine for all except the last where the code goes to the last cell in column "E" and then tries to paste to the next cell down!
    I can't tell the difference of what you are saying what the code is supposed to do, what your description of the problem is, and what the code actually does. They all seem the same. Using the Values in column E, it takes the last E (Third E from the bottom), which happens to be in row 31. Copies it and puts it in row 32. That is what the code has been doing for each blank cell. It copies the cell value above it and pastes it in the blank cell
    seek next empty cell, move up 1 row, copy, move down 1 row, paste. Repeat until no more.
    Line 31 = "E", copy it, paste it into blank cell 32 which is now the last cell in the column

    CopyBlock4.png CopyBlock5.png
    Attached Files Attached Files

  13. #12
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    543
    Thanks
    56
    Thanked 0 Times in 0 Posts
    Maud
    Still can't seem to get the code to work. Attached is a stripped down version of the s/sheet.
    If you run TotalBlocks first and then the ExtraProgCode module the problem manifests itself
    Attached Files Attached Files
    cheers

    Phil Carter

  14. #13
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    How about:
    Code:
    Option Explicit
    Public Sub FillSomeBlanks()
      Dim lLastRow As Long
      Dim lRow As Long
      lLastRow = Cells(Rows.Count, 5).End(xlUp).Row + 1
      For lRow = 3 To lLastRow
       If Cells(lRow, 5) = "" And Cells(lRow, 2) = "" Then
        Cells(lRow, 5) = Cells(lRow - 1, 5)
      End If
      Next
    End Sub
    Steve

  15. #14
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Do you actually need a 2nd routine? Why not simply add the line:
    Cells(availablerow, 5) = Cells(availablerow - 1, 5)

    right before you have the line
    Cells(availablerow, 20) = "Subtotal:"

    In your TotalBlocks code and do it all at once...

    Steve

  16. The Following User Says Thank You to sdckapr For This Useful Post:

    bonriki (2013-11-14)

  17. #15
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Bonriki

    So now I see where the problem is. You are first running a code that places additional blank cells. A very important piece of information left out. The snippet is called from your TotalBlocks subroutine (last line).

    This fixes it with the extra spaces:

    copy3.png

    Code:
    Public Sub CopyRow()
    LastRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row + 1
    [e2].Select
    Repeat:
    AvailableRow = ActiveCell.End(xlDown).Row
    Cells(AvailableRow, 5).Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    ActiveCell.Offset(2, 0).Select
    If ActiveCell.Row >= LastRow Then Exit Sub
    GoTo Repeat
    End Sub
    Attached Files Attached Files
    Last edited by Maudibe; 2013-11-13 at 23:18.

Page 1 of 2 12 LastLast

Posting Permissions

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