CODEWITHSUNDEEP
excelvbacopycopy-pastepaste
TDaw
TDaw

Reputation: 203

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

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

Upvotes: 1

Views: 10773

Answers (2)

TDaw
TDaw

Reputation: 203

I ended up using this code in an attempted to search for another header and copy and paste it Option Explicit

Sub Test()


Dim ws As Worksheet

Set ws = ActiveSheet
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Pivot"
ws.Activate
ActiveSheet.Select

Dim LRow As Long, Found As Range

Set Found = ws.Range("A1:EM1").Find("Bsp") '<== 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

ws.Activate
ActiveSheet.Select

Set Found = ws.Range("A1:EM1").Find("Sog")

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("B1").PasteSpecial xlPasteValues

End If

End Sub

Upvotes: 0

urdearboy
urdearboy

Reputation: 14580

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

Upvotes: 3

Related Questions