selecting and copying non-contiguous cells

[demerson]

I'm trying to write a macro that will automatically select several non-contiguous cells, copy them, and then paste them onto a different sheet.

I don't want to make the user select them by hand with control+click, and the cells are not in fixed rows, but the columns will always be the same.

any help would be great.
thanks

 

[demerson]

additionally, the cells I am trying to copy are at a fixed location relative to the button the user will click to execute the macro. I have been trying to use activecell.offset(), but have not been sucessful.
thanks!

 

[pedie]

how will the macro recognize non-contiguous cells??

 

[demerson]

The cells that I want to copy will always be in the same columns (1,2,4,7,9,13...), the row will change based on how many sets there are. The way I want to have it is that when a user wants to publish a particular set they click a button below the set, which copies the desired cells to a sheet they can print.
I could just move each cell individually, but that seems painful and slow.

 

[demerson]

I have been trying to do something like this, but it does not work

Range(ActiveCell.Offset(-3, 0), ActiveCell.Offset(-3, 1), ActiveCell.Offset(-3, 2), _
ActiveCell.Offset(-3, 4), ActiveCell.Offset(-3, 7), ActiveCell.Offset(-3, 9),

 

[mikerickson]

It depends on how your data is layed-out and if it is always the same pattern.

Just a shot in the dark, but would Shapes(Application.Caller).TopLeftCell.CurrentRegion help isolate the set that you are working with?

 

[demerson]

I think I figured it out....

This is what I did, but I know there has to be a better way. I am really new to this, so please let me know if I am doing this the most painful way possible (which is likely)
Thanks

Dim rCell As Range
Dim TestRange As Range
Dim CopyRange As Range
Dim pub_r As Long
Dim pub_c As Long

pub_r = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row
pub_c = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Column
Cells(pub_r, pub_c).Select
ActiveCell.Offset(-3, 0).Select
    
    Set TestRange = Sheets("pts").Range(ActiveCell, Cells(ActiveCell.Row, ActiveCell.Column + 23))
    
    For Each rCell In TestRange
        If Not IsEmpty(rCell) Then
            If CopyRange Is Nothing Then
                Set CopyRange = rCell
            Else
                Set CopyRange = Union(CopyRange, rCell)
            End If
        End If
    Next rCell
    
    CopyRange.Copy Sheets("print").Range("A2")
 

End Sub