Macro to Copy and paste data based on column headings

Hi

I'm very new to writing Macros in Excel, and have done a bit of looking around to try and solve my problem, but I haven't found a solution yet that works.

I'm trying to write a Macro to do the following:

I'm trying to copy data from Sheet 1, Workbook 1 based on column headings (so for example, I want to copy all the data under the column name "Sort"). The number of rows of data in this row may increase/decrease. I then want to paste this data into Sheet 2, Workbook 2 under the column name "Name". Columns may be added/removed from both workbooks, which is why I want to write the macro to copy based on the column name rather than a column number.

I have been using the below code, which I've tried putting together based on similar but slightly different requests I've found online, but when I run the macro, nothing much happens - I've written the Macro in Workbook 2 and it just opens Workbook 1.

If anyone can see something wrong with my code or suggest an alternative, I'd be extremely grateful for any help. Thanks!!!

Sub CopyProjectName()

Dim CurrentWS As Worksheet
Set CurrentWS = ActiveSheet

Dim SourceWS As Worksheet
Set SourceWS = Workbooks("Workbook1.xlsx").Worksheets("Sheet1")
Dim SourceHeaderRow As Integer: SourceHeaderRow = 1
Dim SourceCell As Range, sRange As Range, Rng As Range

Dim TargetWS As Worksheet
Set TargetWS = Workbooks("Workbook2.xlsm").Worksheets("Sheet2")
Dim TargetHeader As Range
Set TargetHeader = TargetWS.Range("A1:AX1")

Dim RealLastRow As Long
Dim SourceCol As Integer

Range("B2").Select

SourceWS.Activate
     LastCol = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
       Set sRange = Sheets("Sheet1").Range("A1", Cells(1, LastCol))
           With sRange
               Set Rng = .Find(What:="Sort", _
               After:=.Cells(1), _
               LookIn:=xlValues, _
               LookAt:=xlWhole, _
               SearchOrder:=xlByRows, _
               SearchDirection:=xlPrevious, _
               MatchCase:=False)
       If Not Rng Is Nothing Then
           LastRow = Sheets("Sheet1").Cells(Rows.Count, Rng.Column).End(xlUp).Row
               Sheets("Sheet1").Range(Rng, Cells(LastRow, Rng.Column)).Copy
               
TargetWS.Activate
    Sheets("Sheet2").Range("B1").Paste
               
    End If
    End With

End Sub