Move multiple columns

[mycarpark]

I want to copy the particular columns to worksheet2.
The following macro is working fine.

But if I need to select the "type" column of "O" first.
And then move the columns of name , address , nature to worksheet2
How can i modified the following macro...

thanks
...
====

<code>Sub MoveColumns() 
Dim wsO As Worksheet 
Dim wsF As Worksheet 
Dim i As Integer 
 Application.ScreenUpdating = False 
Set wsO = Worksheets("worksheet2") 
Set wsF = Worksheets("worksheet2") 
 myColumns = Array("Name", "Addr", "Nature", "type") 
With wsO.Range("A1:AG1") 
For i = 0 To UBound(myColumns) 
On Error Resume Next 
 .Find(myColumns(i)).EntireColumn.Copy Destination:=wsF.Cells(1, i + 1) 
 Err.Clear 
Next i 
End With 
Set wsO = Nothing 
Set wsF = Nothing 
 Application.ScreenUpdating = True 
End Sub</code>

 

[mycarpark]

Not so sure to add instructon
to select "type" that equals to "O"

 

[Peter_SSs]

Welcome to the MrExcel board!

I'm not sure what you are asking.

 

[mycarpark]

Worksheet1

Name Addr Nature type classno
John 123 A O 19
Peter 456 B X 20
Mary 177 B M 21


Right now the above code will copy the 1st -4th columns by matching title to worksheet2
Name Addr Nature type
John 123 A O
Peter 456 B X
Mary 177 B M


But if i only want to select type =X for moving columns.

Name Addr Natue type
Peter 456 B X

Welcome to the MrExcel board!

I'm not sure what you are asking.

 

[Peter_SSs]

OK, try this. (I have assumed that your code was meant to set wsO as 'worksheet 1' not 'worksheet2', the same as wsF)

Sub MoveColumns_v2()
  Dim wsO As Worksheet, wsF As Worksheet
  Dim i As Long, TypeCol As Long
  Dim myColumns As Variant

  Application.ScreenUpdating = False
  Set wsO = Worksheets("worksheet1")
  Set wsF = Worksheets("worksheet2")
  myColumns = Array("Name", "Addr", "Nature", "type")
  With wsO.Range("A1:AG1")
    TypeCol = .Find(What:="Type").Column
    .AutoFilter Field:=TypeCol, Criteria1:="X"
    For i = 0 To UBound(myColumns)
      On Error Resume Next
      .Find(myColumns(i)).EntireColumn.Copy Destination:=wsF.Cells(1, i + 1)
      Err.Clear
    Next i
  End With
  Set wsO = Nothing
  Set wsF = Nothing
  Application.ScreenUpdating = True
End Sub