Excel VBA - search columns by header and paste into new sheet

Question

I am new to VBA...trying to search specific columns by name and paste them into a new sheet.

What I have so far seems clunky and does not copy or paste the desired column but what I currently have on my clipboard!

Ideally I would be able to search 3 different columns and paste them on to the new sheet.

Any help would be greatly appreciated

Dim CheckText As String
Dim CheckRow As Long
Dim FindText As Range
Dim CopyColumn As String
CheckText = “Bsp” 'Bsp is an example header
CheckRow = 1 'Row with desired header
Dim oldsheet As Worksheet

Set oldsheet = ActiveSheet
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Pivot"
oldsheet.Activate
ActiveSheet.Select
'trying here to create a new sheet, name it and go back to the first sheet
Set FindText = Rows(CheckRow).Find(CheckText)
If FindText Is Nothing Then
MsgBox "Bsp not found"
End If

CopyColumn = Cells(CheckRow, FindText.Column).Column
Columns(CopyColumn).Select.Copy

Sheets("Pivot").Select

ActiveSheet.Paste

Answer 1

This is just a generic example that you can adjust to fit your needs. The code will look for column header named Some String. IF this column is found, we next determine the last row, copy the column (down to last row), and then paste the column in cell A1 on Pivot sheet.

1. Use the range variable Found to store your column header properties (namely location)
2. Check if the header is actually found! If Not Found is Nothing (Translation: Found)
3. Use Found.Column to reference the column index which fits into the Cells property nicely since the syntax is Cells(Row Index, Column Index)

---

Option Explicit

Sub Test()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<== Sheet that has raw data
Dim LRow As Long, Found As Range

Set Found = ws.Range("A1:Z1").Find("Some String") '<== Header name to search for

If Not Found Is Nothing Then
    LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
    ws.Range(ws.Cells(1, Found.Column), ws.Cells(LRow, Found.Column)).Copy
    Sheets("Pivot").Range("A1").PasteSpecial xlPasteValues '<== Sheet to paste data
End If

End Sub

You are going to want to amend some of the options on the Range.Find method. Details can be found here