Export selected column to new workbook

[Manish Sharma]

Hi Friends,

I am trying to copy selected columns to a new workbook.

- Copy selected columns in ListBox1 to a new workbook
- Row containing data will keep on changing (can increase or decrease), I mean to say that Range("B425") is not fixed. So I need to keep it dynamic
- For column selection i am trying to use ActiveX ListBox (so that multiple selection is enable), if you want you can use some other method also


Thanks & Regards,
Manish

 

[SirJB7]

Hi, Manish Sharma!

Give a look at this file:
https://dl.dropboxusercontent.com/u...lumns (for Manish Sharma at chandoo.org).xlsm

It uses 2 named ranges for the data table and the title list in 1st worksheet:
DataTable: =DESREF(Sheet1!$B$3;;;CONTARA(Sheet1!$B:$B);CONTARA(Sheet1!$3:$3)-2) -----> in english: =OFFSET(Sheet1!$B$3,,,COUuNTA(Sheet1!$B:$B),COUNTA(Sheet1!$3:$3)-2)
TitleList: =DESREF(DataTable;;;1 -----> in english: =OFFSET(DataTable,,,1,)

This is the code for the command button:

Option Explicit

Sub WouldntItBeTheSameIfHidingColumnsManuallyAndCopying()
    ' constants
    Const ksWS = "Sheet1"
    Const ksData = "DataTable"
    Const ksTitle = "TitleList"
    ' declarations
    Dim rng As Range, rngD As Range, rngT As Range, lb As Object
    Dim I As Integer, J As Integer, A As String
    ' start
    Set rng = Nothing
    Set rngD = Worksheets(ksWS).Range(ksData)
    Set rngT = Worksheets(ksWS).Range(ksTitle)
    Set lb = Worksheets(ksWS).ListBox1
    ' process
    With rngT
        For I = 0 To lb.ListCount - 1
            If lb.Selected(I) Then
                A = lb.List(I)
                For J = 1 To .Columns.Count
                    If .Cells(1, J).Value = A Then
                        If rng Is Nothing Then
                            Set rng = rngD.Columns(J)
                        Else
                            Set rng = Application.Union(rng, rngD.Columns(J))
                        End If
                        Exit For
                    End If
                Next J
            End If
        Next I
    End With
    If Not (rng Is Nothing) Then
        Workbooks.Add
        rng.Copy [a1]
    End If
    ' end
    Set lb = Nothing
    Set rngT = Nothing
    Set rngD = Nothing
    Set rng = Nothing
    Beep
End Sub

Just advise if any issue.

Regards!

 

[Manish Sharma]

Yes SirJB7, its working fine. Thanks a lot your help .

Also i have another code for for it which is now working fine (but it will not paste it to another sheet). I wanted to share it with other members so here is the code

Private Sub CommandButton1_Click()
Dim My_Cols As String
  For x = 0 To ListBox1.ListCount - 1
  If ListBox1.Selected(x) = True Then
       ActiveSheet.Columns(x + 2).Select
       My_Cols = My_Cols & Selection.Address & ","
  End If
  Next
   
My_Cols = Mid(My_Cols, 1, Len(My_Cols) - 1)
ActiveSheet.Range(My_Cols).Select
End Sub

 

[SirJB7]

Hi, Manish Sharma!
Thanks for sharing your code for selecting selected columns with the community.
Glad you solved it. Thanks for your feedback and welcome back whenever needed or wanted.
Regards!