vba macro for copying columns by name

[jacinthn]

I Have a macro for looking up a column by the header name and copying it into a new sheet, it works when i only have 1 header to copy when i try to add other headers it just goes back and copies the first one in the pose macro, does anyone know how to i get it to move on to the welcome letter header and copy that one on the second run and paste that column in the colums next to the Gym letter column

Sub Pose()
Call CopyByHeader("GYM_LTR")
Call CopyByHeader("WELCOME_LTR")End Sub
Private Sub CopyByHeader(header As String)
Sheets("MAIN").Select
Rows("1:1").Find(What:=header, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).EntireColumn.Copy
End Sub
Sub Mike()
'
' Mike Macro
'
'
Sheets.add After:=Sheets(Sheets.Count)
Application.run ("pose")
Sheets("Sheet1").Select
Columns("A:A").Select
ActiveSheet.Paste
Application.run ("pose")
Sheets("Sheet1").Select
Columns("B:B").Select
ActiveSheet.Paste
End Sub

 

[Datsmart]

This will copy columns from the active worksheet to a new sheet:

Sub CopyColumn()
Dim Myvalue1 As String
Dim Myvalue2 As String
Dim LastCol As Integer
Dim Rng As Range
Dim cs As String
Dim ts As String
Dim sc As String
Dim nc As Integer

'Set variables for Source Sheet
    Myvalue1 = "GYM_LTR"
    Myvalue2 = "WELCOME_LTR"
    cs = ActiveSheet.Name   'Source Sheet Name
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    Set Rng = Sheets(cs).Range(Cells(1, "A"), Cells(1, LastCol))

'Create new worksheet
    Sheets.Add After:=Sheets(Sheets.Count)
    
'Set variables in New Sheet
    ts = ActiveSheet.Name   'Target Sheet Name
    nc = 1                  'Target Sheet Next Column #

    For Each c In Rng
        If c.Value = Myvalue1 Then
            sc = c.Column
            Sheets(cs).Columns(sc).EntireColumn.Copy _
            Destination:=Sheets(ts).Cells(1, nc)
            nc = nc + 1
        End If
        If c.Value = Myvalue2 Then
            sc = c.Column
            Sheets(cs).Columns(sc).EntireColumn.Copy _
            Destination:=Sheets(ts).Cells(1, nc)
            nc = nc + 1
        End If
    Next c
End Sub

Code assumes your sample text exisits in the active worksheet.

 

[jacinthn]

Thanks so much for your help!!!

 

[jacinthn]

Quick question this coding won't copy each column to a seperate worksheet will it? I have 6 columns to copy from a master spreadsheet onto 1 new worksheet on columns a:g

 

[Datsmart]

The code I posted will copy all columns in the active sheet that contain either of the two "Header text" you mentioned to a new worksheet.

Is your request to copy "6 columns" different from your first request?

 

[jacinthn]

i found another code that worked pretty well


sub hilton()
Sheets.add After:=Sheets(Sheets.Count)
Sheets("Source").Select
Sheets("Sheet1").Name = "Pivot"
Cust_Order = WorksheetFunction.Match("Cust_Order", Rows("1:1"), 0)
PRODUCT= WorksheetFunction.Match("PRODUCT", Rows("1:1"), 0)
CUST= WorksheetFunction.Match("cust", Rows("1:1"), 0)

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
Sheets("SOURCE").Columns(Cust_Order ).Copy Destination:=Sheets("Pivot").Range("A1")
Sheets("SOURCE").Columns(PRODUCT).Copy Destination:=Sheets("Pivot ").Range("B1")
Sheets("SOURCE").Columns(CUST).Copy Destination:=Sheets("Pivot ").Range("C1")
Columns("A:D").Select
Range("D1").Activate
Sheets.add<o></o>

 

[rplohocky]

This will copy columns from the active worksheet to a new sheet:

Sub CopyColumn()
Dim Myvalue1 As String
Dim Myvalue2 As String
Dim LastCol As Integer
Dim Rng As Range
Dim cs As String
Dim ts As String
Dim sc As String
Dim nc As Integer

'Set variables for Source Sheet
    Myvalue1 = "GYM_LTR"
    Myvalue2 = "WELCOME_LTR"
    cs = ActiveSheet.Name   'Source Sheet Name
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    Set Rng = Sheets(cs).Range(Cells(1, "A"), Cells(1, LastCol))

'Create new worksheet
    Sheets.Add After:=Sheets(Sheets.Count)
    
'Set variables in New Sheet
    ts = ActiveSheet.Name   'Target Sheet Name
    nc = 1                  'Target Sheet Next Column #

    For Each c In Rng
        If c.Value = Myvalue1 Then
            sc = c.Column
            Sheets(cs).Columns(sc).EntireColumn.Copy _
            Destination:=Sheets(ts).Cells(1, nc)
            nc = nc + 1
        End If
        If c.Value = Myvalue2 Then
            sc = c.Column
            Sheets(cs).Columns(sc).EntireColumn.Copy _
            Destination:=Sheets(ts).Cells(1, nc)
            nc = nc + 1
        End If
    Next c
End Sub

Code assumes your sample text exisits in the active worksheet.

Hello,
Its been a while since this was posted but its exactly what I'm looking for. I am having issues with it though. It keeps erroring out in the 2 lines shown below:

            Sheets(cs).Columns(sc).EntireColumn.Copy _
            Destination:=Sheets(ts).Cells(1, nc)

I assume its because it doesn't know the names of the sheets. Please advise how to name the newly created sheet "Data" and how to make the code complete the process. The name of the sheet from where the columns are being pulled from is "Inventory Report Template - U.S".