Macro to Move Column to Another Sheet Based on Header

Michael151

Board Regular
Joined
Sep 20, 2010
Messages
247
<!--[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!
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Hi,

If I understand correctly the following code should work:

Code:
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
 
Upvote 0
Hi Alx7000,

First thing love the code above, how would I do the above but for 6 different column headings?
Thanks
 
Upvote 0
Try the code below, any questions please let me know.

Code:
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,217
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top