VBA code to Look for Certain Columns by Name and Paste to New Workbook

[zach9208]

Hi all,

I have been searching for a macro for a while now to cleanup a file that has many columns. I have five columns that are named in row 1. I want to grab only these five columns and move to a new workbook. The only catch is that this file sometimes changes and gets additional columns added but the column names never change. In total there are 20+ columns in this workbook and I just want a select few.

For example, I need a macro to scan across row 1 and find (based on the column header name) and copy the following columns: "Portfolio", "Trade Date", "Book Value", "Price Source" and "Currency". I need to skip over column names that do not match. I then want these 5 to paste over the entire column contents to a new workbook.

Any help would be appreciated. Thanks in advance!

 

[JLGWhiz]

Sub getColumns()
Dim nmary As Variant, sh1 As Worksheet, sh2 As Worksheet, i As Long, rng As Range
Set sh1 = ThisWorkbook.ActiveSheet
nmary = Array("Portfolio", "Trade Date", "Book Value", "Price Source", "Currency")
Workbooks.Add
Set sh2 = ActiveWorkbook.Sheets(1)
    For i = LBound(nmary) To UBound(nmary)
        Set rng = sh1.Rows(1).Find(nmary(i), , xlValues).EntireColumn
        rng.Copy sh2.Cells(1, i + 1)
    Next
End Sub

 

[zach9208]

Thanks, JLGWhiz! This code worked perfectly!! Any way to run fit text to columns too after it pastes?

 

[JLGWhiz]

Thanks, JLGWhiz! This code worked perfectly!! Any way to run fit text to columns too after it pastes?

Sub getColumns()
Dim nmary As Variant, sh1 As Worksheet, sh2 As Worksheet, i As Long, rng As Range
Set sh1 = ThisWorkbook.ActiveSheet
nmary = Array("Portfolio", "Trade Date", "Book Value", "Price Source", "Currency")
Workbooks.Add
Set sh2 = ActiveWorkbook.Sheets(1)
    For i = LBound(nmary) To UBound(nmary)
        Set rng = sh1.Rows(1).Find(nmary(i), , xlValues).EntireColumn
        rng.Copy sh2.Cells(1, i + 1)
    Next
[COLOR=#0000CD]sh2.Columns.AutoFit[/COLOR]
End Sub

 

[zach9208]

Is there any way that I can look at row 4 for these headers? I tried modifying the code, but I keep getting an error " object variable or with block variable not set".

Set rng = sh1.Rows(4).Find(nmary(i), , xlValues).EntireColumn

What can I do to check for these headers in column 4 instead of 1. I need to still copy the matching columns to the very bottom of the data. Thanks!