Finding the column with unique value and copying whole column to another workbook

[Geoffrey Baker]

Hi all,
I am trying a macro that will find the word "Fort" in row 5 in the source workbook and copy its whole column to another workbook. Any help please... Thanks.

[StephenR]

If it only occurs once:

Sub x()
  
Dim rFind As Range, wb As Workbook
 
With ThisWorkbook.ActiveSheet.Rows(5)
    Set rFind = .Find(What:="Fort", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not rFind Is Nothing Then
        Set wb = Workbooks.Add
        rFind.EntireColumn.Copy wb.Sheets(1).Range("A1")
    End If
End With
     
End Sub

Or if, as likely, you don't need the whole column:

Sub x()
  
Dim rFind As Range, wb As Workbook
 
With ThisWorkbook.ActiveSheet
    Set rFind = .Rows(5).Find(What:="Fort", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not rFind Is Nothing Then
        Set wb = Workbooks.Add
        Intersect(rFind.EntireColumn, .UsedRange).Copy wb.Sheets(1).Range("A1")
    End If
End With
     
End Sub

[Geoffrey Baker]

Hi Stephen,
The first one worked as a start. The second didn't. How about if I only wanted to copy such range like from row 5 to row 12? Its just that I've got some figures underneath row 12 and above row 5 that I don't need to copy. Thanks.

[StephenR]

Not sure why the second one didn't work. Try this:

Sub x()
  
Dim rFind As Range, wb As Workbook
 
With ThisWorkbook.ActiveSheet.Rows(5)
    Set rFind = .Find(What:="Fort", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not rFind Is Nothing Then
        Set wb = Workbooks.Add
        rFind.Resize(8).Copy wb.Sheets(1).Range("A1")
    End If
End With
     
End Sub

[Geoffrey Baker]

Thanks for that man! That's what I needed!