Select multiple columns and paste them into sheet1 of new workbook - excel

Question

I want to select multiple columns by the column header in an Excel sheet, then copy these columns into a new workbook.
With the code below, Excel opens one book per column instead of pasting all of the selected columns into sheet1 of the new workbook.
I recorded a macro for this task, but the column header changes every time so I cannot depend on recorded macros.
Sub Colheadr()
Dim wsO As Worksheet
'Dim wsF As Worksheet....I comment out this line
Dim i As Integer
Application.ScreenUpdating = False
Set wsO = ActiveSheet
'Set wsF = Worksheets("Final").....I comment out this line
myColumns = Array("Facility", "Last Name", "First Name", "MRN", "adm date")
With wsO.Range("A1:W1")
For i = 0 To UBound(myColumns)
On Error Resume Next
.Find(myColumns(i)).EntireColumn.Copy
Workbook.Add
ActiveSheet.Paste
'Destination:=wsF.Cells(1, i + 1)...I comment out this line
Err.Clear
Next i
End With
Set wsO = Nothing
Set wsF = Nothing
Application.ScreenUpdating = True
End Sub

Answer 1

Try this out:
Public Sub CopyBetweenBooks()
Dim myCollection As Collection
Dim myIterator As Variant
Dim myRng As Range
Dim xlcell As Variant
Dim otherwb As Workbook
Dim mywb As Workbook
Dim colCounter As Integer
Set mywb = ThisWorkbook
Set myCollection = New Collection
'Create a collection of header names to search through
myCollection.Add ("Header1")
myCollection.Add ("Header2")
myCollection.Add ("Header3")
'Where to search, this is the header
Set myRng = ActiveSheet.Range("A1:W1")
Set otherwb = Workbooks.Add
colCounter = 0
For Each xlcell In myRng.Cells ' look through each cell in your header
For Each myIterator In myCollection ' look in each item in the collection
If myIterator = xlcell.Value Then ' when the header matches what you are looking for
colCounter = colCounter + 1 ' creating a column index for the new workbook
mywb.ActiveSheet.Columns(xlcell.Column).Copy
otherwb.ActiveSheet.Columns(colCounter).Select
otherwb.ActiveSheet.Paste
End If
Next
Next
End Sub

Answer 2

I also have the same problem 3 years later in 2019. Ryan Wildry was right. Instead of collection data type use array to maintain user defined column sequence. That's why I am referring Ryan Wildry's solution with additional lines.
Public Sub CopyBetweenBooks()
Dim myCollection(1 To 3) As String
Dim myIterator As Variant
Dim myRng As Range
Dim xlcell As Variant
Dim otherwb As Workbook
Dim mywb As Workbook
Dim colCounter As Integer
Set mywb = ThisWorkbook
'Create an array of header names to search through
myCollection(1) ="Header1"
myCollection(2) ="Header2"
myCollection(3) ="Header3"
'Where to search, this is the header
Set myRng = ActiveSheet.Range("A1:W1")
Set otherwb = Workbooks.Add
colCounter = 0
For i = LBound(myCollection) To UBound(myCollection)
For Each xlcell In myRng.Cells ' look through each cell in your header
If myCollection(i) = xlcell.Value Then ' when the header matches what you are looking for
colCounter = colCounter + 1 ' creating a column index for the new workbook
mywb.ActiveSheet.Columns(xlcell.Column).Copy
otherwb.ActiveSheet.Columns(colCounter).Select
otherwb.ActiveSheet.Paste
End If
Next
Next
Next
End Sub