Macro to Move Column to Another Sheet Based on Header

[Michael151]

<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0in 5.4pt 0in 5.4pt; mso-para-margin:0in; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman";} </style> <![endif]--> Hello all,

Trying to write a macro that will find the column labeled “notes” (in row 1 header) in the worksheet labeled “Full Report”, copy this entire column, then move the column to the worksheet “Secondary Report” and place in column E.

Any help is greatly appreciated – thank you!

 

[alx7000]

Hi,

If I understand correctly the following code should work:

Option Explicit

Sub CopyColumn()

'Note if there is more than one notes column in Full Report this will move the first

'Select Full Report Sheet
Sheets("Full Report").Select

'Find Notes column and copy
Cells.find(What:="Notes", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows).EntireColumn.Copy

'Select Secondary Report sheet, column E and paste
Sheets("Secondary Report").Select
Range("E1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

End Sub

Any questions please let me know.

Cheers,
alx7000

 

[Michael151]

Thanks alx7000, that worked!

 

[Craigeeh22]

Hi Alx7000,

First thing love the code above, how would I do the above but for 6 different column headings?
Thanks

 

[alx7000]

Try the code below, any questions please let me know.

Sub CopyColumns()


'Set the column heading you want. Add as many as you want, comma seperated
'The order you enter determines the order they appear on the second sheet
Dim Titles As Variant
Titles = Array("Heading 1", "Heading 2", "Heading 3", "Heading 4", "Heading 5", "Heading 6")


Dim i As Long 'Counter


For i = 0 To UBound(Titles)




    'Select Full Report Sheet
    Sheets("Full Report").Select
    
    'Find Notes column and copy. If it can't find the title, will move to the next.
    On Error GoTo ErrHandler
        Cells.Find(What:=Titles(i), After:=Range("A1"), _
        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns).EntireColumn.Copy
    On Error GoTo 0
    
    'Select Secondary Report sheet, column E and paste
    Sheets("Secondary Report").Select
    Range("E1").Offset(0, i).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False


NextOne:


Next i


Exit Sub


ErrHandler:
Resume NextOne


End Sub

Cheers,
Alex

 

[spaulblack]

Instead of pasting the row in column E. How would I do this and insert the column in front of column xyz on the "Secondary Report" sheet.
Thanks in advance for your help.

 

[alx7000]

Hi,

If you want to insert rather than paste, replace the line "ActiveSheet.Paste" with "Selection.Insert Shift:=xlToRight" and it should work.

Cheers,
Alex

 

[spaulblack]

Thanks, this has been killing me all day. I'll give this a shot.

Hi,

If you want to insert rather than paste, replace the line "ActiveSheet.Paste" with "Selection.Insert Shift:=xlToRight" and it should work.

Cheers,
Alex

 

[spaulblack]

That worked for inserting instead of pasting over, but I need the column to be placed in certain spot relative to other columns. I need to copy the column and then insert in front of another specific column.
ie I get a spreadsheet with columns ordered:
Obj 3 | Obj 4 | Obj 1 | Obj 2
and I want to reorder the columns to be
Obj 4 | Obj 2 | Obj 3 | Obj 1

Right now I'm cutting the column and pasting in column A B C D. I also get an error if the column is already in the correct location.

Sub FindColumnsCutPaste()
Sheets("Sheet1").Select
Dim rngAddress As Range
Set rngAddress = Range("A1:Z1").Find("Obj 1")
If rngAddress Is Nothing Then
MsgBox "Obj 1 column was not found."
Exit Sub
End If
Range(rngAddress, rngAddress.End(xlDown)).Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight

Set rngAddress = Range("A1:Z1").Find("Obj 2")
If rngAddress Is Nothing Then
MsgBox "Obj 2 column was not found."
Exit Sub
End If
Range(rngAddress, rngAddress.End(xlDown)).Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight

 

[Codey]

Hi

could anyone help with a slight mod to this code?

I'm looking to do pretty much the same but to remove columns to another worksheet based on the column header criteria however I would like the criteria to be a date in the past.

So if worksheet 1 has a row containing every day from now until say 2024 when I open the sheet in a month I want to run a macro that removes all columns in the past to worksheet 2 (an archive of past data) leaving the present date as the first column in worksheet 1.