paste on n-th row if empty (excel 97)

Topic

New Reply

I need a code for pasting the data on column A, starting from A1, then A17, A33, …. A-17th. if previous entry is long than 16, then paste onto next A-17th.
any idea?
thank you very much.

Reply | Quote

Replies

On the basis that:

• your data is contiguous (i.e. no blank cells
• you won’t know how large your blocks of data are until runtime
• you’ve already acrried out the first paste into Column A[/list]try something like:
  ActiveCell.End(xlDown).Offset(1,0).Activate
  ActiveSheet.Paste
  or would you like to be a bit more specific about the source and target formats? HTH

Reply | Quote

Assuming that the data you paste does not include blank cells, the following should select the next cell as I think you want :

    If ActiveCell.Row  1 Then
        ActiveCell.Offset(17 - ActiveCell.Row Mod 17, 0).Select
    End If
    ActiveSheet.Paste
    ActiveCell.End(xlDown).Select

This means that each block of data will occupy 1 or more 16 cell blocks of cells.

Andrew C

Reply | Quote

Maybe I did not explain clearly.
I want to copy data from 5 sheets into one sheet (sumu). on this sheet I only use column A. paste the first sheet data on A1, When paste the second sheet data, I need to find next empty n*17th cell like A17 or A33 or A49…etc, depends on how long the first set data is. please see the attachment.

Reply | Quote

Andrew understood you more clearly than I did! The code (slightly modified from what Andrew posted) is as follows:

Sub CopyOut()
Sheets("Sheet1").Activate
'this is in case Cell A1 in SUMU is not selected.  
Range(("A1"), Range("A1").End(xlDown)).Copy
Sheets("SUMU").Activate
Range("A1").Activate
ActiveSheet.Paste
ActiveCell.End(xlDown).Activate
Sheets("Sheet2").Activate
PasteIn
Sheets("Sheet3").Activate
PasteIn
Sheets("Sheet4").Activate
PasteIn
Sheets("Sheet5").Activate
PasteIn
End Sub

Sub PasteIn()
Range(("A1"), Range("A1").End(xlDown)).Copy
Sheets("SUMU").Activate
If ActiveCell.Row  1 Then
    ActiveCell.Offset(17 - ActiveCell.Row Mod 16, 0).Activate
End If
ActiveSheet.Paste
ActiveCell.End(xlDown).Activate
End Sub

You simply need to run CopyOut. The other Sub is simply to reduce repetition. Please post back if you have any queries.

Reply | Quote

Here is an adaption of teh code from above. It seems to work the way you want.

Sub PasteToEveryNth()
Dim ws As Worksheet
Sheets(1).[A1].Select
For Each ws In ThisWorkbook.Sheets
    If ws.Index  1 Then
        ws.Range(ws.[A1], ws.[A1].End(xlDown)).Copy
        If ActiveCell.Row  1 Then
            ActiveCell.Offset(17 - ActiveCell.Row Mod 16, 0).Select
        End If
        ActiveSheet.Paste
        ActiveCell.End(xlDown).Select
    End If
Next
End Sub

Andrew C

Reply | Quote

They are wonderful solutions.
thank you all your help.

Reply | Quote