Thread: Export Data based cell value

Hi all!

First post on here so hello My query is quite straightforward, I need to export data from one spreadsheet into another, new spreadsheet (which should be created when the macro is run). The idea is that each column and row will have a tick box at the top/side of them, the user will tick each column or row that the want on the other spreadsheet and when a button is clicked, the whole lot gets copied to the newly created sheet (without the links).

Is this do able? I have tried to make it work but im not very fluent in vba at all.

Attachment 136043

Thanks in advance

Storm08

Please attach the sample workbook.

I cant put the actually sheet on here because of confidential reasons but here's an example to give you an idea
I dont know what the best way would be to go about it, it's had me stumped for a good few days because of my limited experience with programming in vb.
Thanks for the reply

So if a checkbox is clicked, which sections should be copied? For example, in your attachment, if only A3 is clicked, then should only row 3 be copied without the headers?

assuming:
- the data in sheet1
- the sheet to be copied to sheet2
- the ActiveX-checkbox for column G Checkbox7

Private Sub Checkbox7_Click()
  if checkbox7 then sheets("sheet2").columns(7)=sheets("sheet1").column(7).value
End Sub

I don't really get what you are after, but give this a go.

It will put it onto sheet 2 in the first instance, but can be easily adapted to another workbook.

Sub test()
Dim shpsRng As Collection
Dim rng As Range
Dim oCell As Object
Dim x As Integer

Set shpsRng = New Collection

For x = 1 To Sheet1.Shapes.Count
    If Sheet1.CheckBoxes(x).Value = 1 Then
        shpsRng.Add Sheet1.CheckBoxes(x).TopLeftCell
    End If
Next x

With Sheet1.Cells(3, 3).CurrentRegion
    For x = 1 To shpsRng.Count
        If shpsRng(x).Row = 1 Then
            If Not rng Is Nothing Then
               Set rng = Union(rng, .Columns(shpsRng(x).Column - 1))
            Else
               Set rng = .Columns(shpsRng(x).Column - 1)
            End If
        Else
            If Not rng Is Nothing Then
                Set rng = Union(rng, .Rows(shpsRng(x).Row - 1))
            Else
                Set rng = .Columns(shpsRng(x).Row - 1)
            End If
        End If
    Next x
End With

For Each oCell In rng
   Sheet2.Range(oCell.Address) = oCell.Value
Next


End Sub

Wow, thanks for the replies, ill give them a go and let you know

What error message do you get?

Try this:

Sub test()
Dim shpsRng As Collection
Dim rng As Range
Dim oCell As Object
Dim x As Integer

Set shpsRng = New Collection

For x = 1 To Sheet1.Shapes.Count
    If Sheet1.CheckBoxes(x).Value = 1 Then
        shpsRng.Add Sheet1.CheckBoxes(x).TopLeftCell
    End If
Next x

If shpsRng.Count <> 0 Then

    With Sheet1.Cells(3, 3).CurrentRegion
        For x = 1 To shpsRng.Count
            If shpsRng(x).Row = 1 Then
                If Not rng Is Nothing Then
                   Set rng = Union(rng, .Columns(shpsRng(x).Column - 1))
                Else
                   Set rng = .Columns(shpsRng(x).Column - 1)
                End If
            Else
                If Not rng Is Nothing Then
                    Set rng = Union(rng, .Rows(shpsRng(x).Row - 1))
                Else
                    Set rng = .Rows(shpsRng(x).Row - 1)
                End If
            End If
        Next x
    End With
    
    
    For Each oCell In rng
        Sheet2.Range(oCell.Address) = oCell.Value
    Next

Else
    MsgBox "Nothing was selected"
    
End If

End Sub

The error message doesnt come up anymore and the message box appears when you uncheck it. Would it be possible to undo or delete the column of data when the box is unchecked?

Sorry im asking a lot, i would like to try and do it myself but im still trying to get my head round your first bit of code :P

This is a massive help so far! thank you very much!

EDIT:

Oh and also,it only copies a certain amount to the other sheet. I would have changed the range of data copied but i wasn't sure what to change.

maybe this:

Sub test()
Dim shpsRng As Collection
Dim rng As Range
Dim oCell As Object
Dim x As Integer



Set shpsRng = New Collection

For x = 1 To Sheet1.Shapes.Count
    If Sheet1.CheckBoxes(x).Value = 1 Then
        shpsRng.Add Sheet1.CheckBoxes(x).TopLeftCell
    End If
Next x
Sheet2.Range(Sheet1.Cells(3, 3).CurrentRegion.Address).ClearContents

If shpsRng.Count <> 0 Then
    With Sheet1.Cells(3, 3).CurrentRegion
        For x = 1 To shpsRng.Count
            If shpsRng(x).Row = 1 Then
                If Not rng Is Nothing Then
                   Set rng = Union(rng, .Columns(shpsRng(x).Column - 1))
                Else
                   Set rng = .Columns(shpsRng(x).Column - 1)
                End If
            Else
                If Not rng Is Nothing Then
                    Set rng = Union(rng, .Rows(shpsRng(x).Row - 1))
                Else
                    Set rng = .Rows(shpsRng(x).Row - 1)
                End If
            End If
        Next x
    End With
    
    
    For Each oCell In rng
        Sheet2.Range(oCell.Address) = oCell.Value
    Next

Else
    MsgBox "Nothing was selected"
    
End If

End Sub