Macro to copy and paste based on column headings - excel

Question

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

Answer 1

Workbook1.xlsx and Workbook2.xlsm have to be open for the code bellow
Option Explicit
Public Sub CopyProjectName()
Dim sourceWS As Worksheet, targetWS As Worksheet
Dim lastCol As Long, lastRow As Long, srcRow As Range
Dim found1 As Range, found2 As Range
Set sourceWS = Workbooks("Workbook1.xlsx").Worksheets("Sheet1") 'Needs to be open
Set targetWS = Workbooks("Workbook2.xlsm").Worksheets("Sheet2") 'Needs to be open
With sourceWS
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
Set srcRow = .Range("A1", .Cells(1, lastCol))
Set found1 = srcRow.Find(What:="Sort", LookAt:=xlWhole, MatchCase:=False)
If Not found1 Is Nothing Then
lastCol = targetWS.Cells(1, Columns.Count).End(xlToLeft).Column
Set srcRow = targetWS.Range("A1", targetWS.Cells(1, lastCol))
Set found2 = srcRow.Find(What:="Name", LookAt:=xlWhole, MatchCase:=False)
If Not found2 Is Nothing Then
lastRow = .Cells(Rows.Count, found1.Column).End(xlUp).Row
.Range(.Cells(2, found1.Column), .Cells(lastRow, found1.Column)).Copy
found2.Offset(1, 0).PasteSpecial xlPasteAll
End If
End If
End With
End Sub