CODEWITHSUNDEEP
excelvba
Divaansh
Divaansh

Reputation: 17

Excel Macro to copy specific columns(with Headers) from all the sheets to new workbook

Need help with an excel macro which helps to copy specific columns with headers from specified sheets to a new workbook. Columns Headers are not in particular sequence hence we need to specify the headers name so that the columns will be identified to copy it into new workbook.

Note : there are more than 100 columns in which i will have to pull around 60-70 columns which are not in sequential order

Column1 Column2 Column3 Column4 Column5
Data1 Data2 Data3 Data4 Data5
Data1 Data2 Data3 Data4 Data5
Data1 Data2 Data3 Data4 Data5

For Example : I need to copy column 3 which is having header as COLUMN3 , and column 5 which is having header as COLUMN5. It should copy data from specified column headers to new workbook.

Expected Result in new workbook will look like below

Column3 Column5
Data3 Data5
Data3 Data5
Data3 Data5

Upvotes: 0

Views: 208

Answers (1)

karma
karma

Reputation: 2009

If I understand you correctly, maybe the code below can help you get started :

Sheet1 is the data something like this :
enter image description here

Expectation:
A userform with one listbox (contains all the header name in sheet1) and one button is shown, so the user can select which header he want to "display" in a new workbook based on his selection sequence in the listbox.

enter image description here

In the Userform module :

Dim rg As Range: Dim WBtrg As Workbook: Dim WBsrc As Workbook

Private Sub UserForm_Initialize()
Set WBsrc = ThisWorkbook
Set rg = WBsrc.Sheets("Sheet1").UsedRange 'change as needed
ListBox1.List = Application.Transpose(Application.Transpose(rg.Rows(1)))
Set WBtrg = Workbooks.Add
End Sub

Private Sub ListBox1_Click()
rg.Columns(rg.Find(ListBox1.Value, lookat:=xlWhole).Column).Copy
    With WBtrg.Sheets(1)
        If .Range("A1").Value = "" _
            Then .Range("A1").PasteSpecial (xlAll) _
            Else .Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial (xlAll)
    End With
End Sub

Private Sub CommandButton1_Click()
    With WBtrg.Sheets(1).Cells(1, Columns.Count).End(xlToLeft)
        If .Value <> "" Then .EntireColumn.Delete
    End With
End Sub

The initialize sub : set the source workbook as WBsrc and set the target workbook as WBtrg which is a new workbook. Set the range of data as rg variable from WBsrc sheet1. Populate the Listbox1 with the header name in rg.

ListBox1_Click sub : copy the data of the respected header in rg which is the clicked item value in the Listbox1 and paste it to the new workbook (WBtrg) sheet1.

CommandButton1_Click sub : to undo the last copied/pasted column data.

Another style....

in the Userform module :

Dim rg As Range: Dim WBtrg As Workbook: Dim WBsrc As Workbook
Dim arrHdr: Dim i As Integer

Private Sub UserForm_Initialize()
Set WBsrc = ThisWorkbook
Set rg = WBsrc.Sheets("Sheet1").UsedRange 'change as needed
arrHdr = Application.Transpose(Application.Transpose(rg.Rows(1)))
Set WBtrg = Workbooks.Add
End Sub

Private Sub ComboBox1_Click()
With ComboBox1
    ListBox1.AddItem .Value
    .SelStart = 0
    .SelLength = Len(.Text)
End With
End Sub

Sub ComboBox1_Populate(Optional fltr As String)
    ComboBox1.List = Filter(arrHdr, fltr, , vbTextCompare)
End Sub

Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With ComboBox1
        Call ComboBox1_Populate(.Text)
        .DropDown
    End With
End Sub

Private Sub CommandButton1_Click()
For i = 0 To ListBox1.ListCount - 1
rg.Columns(rg.Find(ListBox1.List(i), lookat:=xlWhole).Column).Copy
    With WBtrg.Sheets(1)
        If .Range("A1").Value = "" _
            Then .Range("A1").PasteSpecial (xlAll) _
            Else .Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial (xlAll)
    End With
Next i
End Sub

Add one Combobox to the userform (leave the default name which is ComboBox1). Set this Combobox MatchEntry property to 2-frmMatchEntryNone

User can type in the combobox and the dropdown will show the match value with his typed letter. Each time the user select/click the item in the Combobox dropdown, the item name (which is the header name) will be added to the Listbox. Continue to add the header name to the Listbox as many as needed. Then click the command button to put the selected header name data in the new workbook sheet1, starting in column A.

Upvotes: 0

Related Questions