Copy Columns Based on Header matching a variable to another sheet in VBA

[weaselmcguff]

We have a rather large file that exports 256 columns of data. We want to use VBA to copy 14 of the columns to another sheet. The columns are scattered through out the entire workbook. I have the code created to create the new sheet. Now I am trying to figure out how to copy the entire column to the new sheet. Problem is the columns are never in the same order when the file is exported. Today Customer could be column A tomorrow it is d.

some of the columns we are trying to copy are
Customer, Parts, Action, Area, Owner, Standard Fault, Qty, TI, TU, etc

Any suggestions?

 

[JoeMo]

If there are no duplicate column headers among the 256 columns, use the headers to find and copy the desired columns.

 

[weaselmcguff]

The people that are running/creating these reports are not that computer savy. We were try to make this as easy as we can for them. Basically they run a macro and it pulls the data over to the spreadsheet for them.

 

[JoeMo]

The people that are running/creating these reports are not that computer savy. We were try to make this as easy as we can for them. Basically they run a macro and it pulls the data over to the spreadsheet for them.

What do you need help with?

 

[weaselmcguff]

We have a rather large file that exports 256 columns of data. We want to use VBA to copy 14 of the columns to another sheet. The columns are scattered through out the entire workbook. I have the code created to create the new sheet. Now I am trying to figure out how to copy the entire column to the new sheet. Problem is the columns are never in the same order when the file is exported. Today Customer could be column A tomorrow it is d.

some of the columns we are trying to copy are
Customer, Parts, Action, Area, Owner, Standard Fault, Qty, TI, TU, etc.
We want to be able to hit a hot button that would execute the command to: Create the new work sheet, find and copy over the entire column based on a series of columns for that sheet.

 

[JoeMo]

We have a rather large file that exports 256 columns of data. We want to use VBA to copy 14 of the columns to another sheet. The columns are scattered through out the entire workbook. I have the code created to create the new sheet. Now I am trying to figure out how to copy the entire column to the new sheet. Problem is the columns are never in the same order when the file is exported. Today Customer could be column A tomorrow it is d.

some of the columns we are trying to copy are
Customer, Parts, Action, Area, Owner, Standard Fault, Qty, TI, TU, etc.
We want to be able to hit a hot button that would execute the command to: Create the new work sheet, find and copy over the entire column based on a series of columns for that sheet.

You can specify "etc" where noted in the code below. Assumes your imported data sheet is the active sheet when you run the code and that the unique column headers in the array Hdrs are in the first row of that sheet. Expand or contract the array to select only the columns you want to copy to the new sheet. The new sheet is created for you and placed immediately after the imported data sheet.

Sub weasel()
'The sheet with all the imported data columns must be active when this macro is run
Dim newSht As Worksheet, sSht As Worksheet, Hdrs As Variant, i As Long, Fnd As Range
Set sSht = ActiveSheet
'Expand the array below to include all relevant column headers
Hdrs = Array("Customer", "Parts", "Action", "Area", "Owner", "Standard Fault", "Qty", "TI", "TU")
Application.ScreenUpdating = False
Set newSht = Worksheets.Add(after:=sSht)
With sSht.UsedRange.Rows(1)
    For i = LBound(Hdrs) To UBound(Hdrs)
        Set Fnd = .Find(Hdrs(i), lookat:=xlWhole)
        If Not Fnd Is Nothing Then
            Intersect(Fnd.EntireColumn, sSht.UsedRange).Copy Destination:=newSht.Cells(1, i + 1)
        End If
    Next i
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub

 

[weaselmcguff]

Thanks Joe it worked Perfect.

How would we copy the original Column Widths to the new sheet?

Thanks for everything

 

[JoeMo]

Thanks Joe it worked Perfect.

How would we copy the original Column Widths to the new sheet?

Thanks for everything

You are welcome. As to your question:

Change this:

Intersect(Fnd.EntireColumn, sSht.UsedRange).Copy Destination:=newSht.Cells(1, i + 1)

To this:

Intersect(Fnd.EntireColumn, sSht.UsedRange).Copy
newSht.Cells(1, i + 1).PasteSpecial Paste:=xlPasteAll
newSht.Cells(1, i + 1).PasteSpecial Paste:=xlPasteColumnWidths

 

[weaselmcguff]

Work Perfect thanks Joe
Much Appreciated.

 

[JoeMo]

Work Perfect thanks Joe
Much Appreciated.

You are welcome - thanks for the reply.