Copy From A Range To A Range

[Guest]

Hello All,
I am trying to figure out how to copy values from a range to another range.

I have a checkbox setup in each row from 16-45. If the checkbox is ticked it
will copy the range "B(row number)" to "K(same row number)" to a new sheet
and insert it under the last entry within rows 16-45.
There are no formula's or anything to be copied, just the cell contents.
Any advice welcomed

Regards
Peter

 

[Ron de Bruin]

Hi Peter

If you use Linkedcell for each checkbox you can use AutoFilter to
filter on TRUE.
This way you can copy it to a new sheet

Maybe you like this
http://www.rondebruin.nl/copy5.htm

 

[Dave Peterson]

Did you use a checkbox from the Control Toolbox toolbar or from the Forms
toolbar?

I think for things like this, the Forms toolbar version of the checkbox is lots
easier to work with.

You can assign the same macro to each of those checkboxes.

I used column B of the Sheet2 to determine the next available row.

Option Explicit
Sub testme()

Dim myCBX As CheckBox
Dim myRow As Long
Dim DestCell As Range
Dim RngToCopy As Range

With ActiveSheet
Set myCBX = .CheckBoxes(Application.Caller)

If myCBX.Value = xlOff Then
Exit Sub
End If

myRow = myCBX.TopLeftCell.Row

Set RngToCopy = .Range(.Cells(myRow, "B"), .Cells(myRow, "K"))

End With

With Worksheets("sheet2")
Set DestCell = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
End With

DestCell.Resize(RngToCopy.Rows.Count, RngToCopy.Columns.Count).Value _
= RngToCopy.Value

myCBX.Value = xlOff

End Sub

 

[Guest]

Thanks Dave and Ron =)

I have now used the checkboxes from the forms toolbar, and it works..I still
have one slight problem though.
How do I set it to not go past "B46", but instead open another sheet if it
needs to?

Regards
Peter

 

[Dave Peterson]

How about:

Option Explicit
Dim OtherWks As Worksheet
Sub testme()

Dim myCBX As CheckBox
Dim myRow As Long
Dim DestCell As Range
Dim RngToCopy As Range
Dim maxRow As Long
Dim CurSelection As Range

Application.ScreenUpdating = False

If OtherWks Is Nothing Then
Set OtherWks = Worksheets("sheet2")
End If
maxRow = 46

With ActiveSheet
Set myCBX = .CheckBoxes(Application.Caller)

If myCBX.Value = xlOff Then
Exit Sub
End If

myRow = myCBX.TopLeftCell.Row

Set RngToCopy = .Range(.Cells(myRow, "B"), .Cells(myRow, "K"))

End With

With OtherWks
Set DestCell = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
End With

If DestCell.Row > maxRow Then
Set CurSelection = Selection
Set OtherWks = Worksheets.Add
Set DestCell = OtherWks.Range("b1")
Application.Goto CurSelection
End If

DestCell.Resize(RngToCopy.Rows.Count, RngToCopy.Columns.Count).Value _
= RngToCopy.Value

myCBX.Value = xlOff
Beep 'just a noise

Application.ScreenUpdating = True

End Sub