Copy selected columns from Sheet1 to Sheet2 VBA solution required. Not a straight copy.

Hi guys and excel VBA experts.
I need a bit of help here.
I have been successful in adapting code to my needs and did ask for a lot of help in a previous post. It's done in a messey way, but works. I would like to optimise the code once this part is resolved and would appreciate someone looking at my code and optimizing it if they are willing.
However, in this request, I need help with a small portion of the code as I have been able to get it to work if my source is in a specific order, which is not always the case.

So here goes.
The hidden sheet called "Temp" holds data that is pasted from the Windows clipboard. It is all in format Text, just as I need it.
There is another sheet called "Analyse" where only certain columns are copied from the "Temp" sheet.

They are in a defined array ar with the following column names "CRN", "Customer Name", "Circuit/Equip ID", "Extension", "SLA", "Service Type", "Status".
These columns are not allways in the correct order as above in the "Temp" sheet, and there are other colums inbetween these columns too.
The destination columns however need to remain in the order as indicated in the array. I have measures and lookup values in the destination sheet.
A third sheet holds pivot tables that uses the "Analyse" sheet table for some simple measures.

What I need to happen is that when Analyse is run, the desired columns need to be "looked for" in sheet "Temp", copied from row 2 down, and pasted in the defined order in the "Analyse" sheet from row 2 down.
In the "Analyse" sheet there are currently formulas for INDEX and MATCH in columns H, I and J that are using three other sheets to lookup data and fill those cells, but I am working on a solution to add the formula using VBA on the cells, only if column D has a value as that one is "Customer Name" and will never be blank. Suppose I could also just count the rows of data and fill the formula from row 2 down to last data row, and use this for the three formulas.
Also currently my code removes the headers in the "Analyse" sheet as I select the sheet columns A:J and use ClearContents, which then breaks the measures in the Pivot Tables as the table headers are missing. This I need to fix that it clears from row 2 down, but only once I resolve the formula entry with VBA.

I have started on another project where I'm using enums, but I don't quite understand it yet and have other classes starting which is leaving me with little time to figure this request out. I know I will eventually, but I have about 60 people using this spreadsheet and I cannot go to every individual to rearange their desktop app's columns for the source. I would appreciate any help that is provided. Efficient code is a must as I need this to run as fast as possible, which it is not doing too bad at the moment.

I've had to include compatability for older OS and Office versions. Oh and there's a search form that is used on one of the sheets too.

Here follows my code.

Option Explicit
#If VBA7 Then

    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" _
            (ByVal hWnd As Long, _
             ByVal nIndex As Long _
            ) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
            (ByVal hWnd As Long, _
             ByVal nIndex As Long _
            ) As LongPtr
    #End If

    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" _
            (ByVal hWnd As LongPtr, _
             ByVal nIndex As Long, _
             ByVal dwNewLong As LongPtr _
            ) As LongPtr
    #Else
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
            (ByVal hWnd As LongPtr, _
             ByVal nIndex As Long, _
             ByVal dwNewLong As LongPtr _
            ) As LongPtr
    #End If

    Private Declare PtrSafe Function SetWindowPos Lib "user32" _
        (ByVal hWnd As LongPtr, _
         ByVal hWndInsertAfter As LongPtr, _
         ByVal X As Long, ByVal Y As Long, _
         ByVal cx As Long, ByVal cy As Long, _
         ByVal wFlags As Long _
        ) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
         ByVal lpWindowName As String _
        ) As LongPtr
    Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As LongPtr, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lParam As Any _
        ) As LongPtr
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" _
        (ByVal hWnd As LongPtr) As LongPtr

#Else

    Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As Long, _
         ByVal nIndex As Long _
        ) As Long
    Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, _
         ByVal nIndex As Long, _
         ByVal dwNewLong As Long _
        ) As Long
    Private Declare Function SetWindowPos Lib "user32" _
        (ByVal hWnd As Long, _
         ByVal hWndInsertAfter As Long, _
         ByVal X As Long, ByVal Y As Long, _
         ByVal cx As Long, ByVal cy As Long, _
         ByVal wFlags As Long _
        ) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
         ByVal lpWindowName As String _
        ) As Long
    Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lParam As Any _
        ) As Long
    Private Declare Function DrawMenuBar Lib "user32" _
        (ByVal hWnd As Long) As Long

#End If


'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

#If Mac Then
    ' do nothing
#Else
    #If VBA7 Then
        Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
                                                             ByVal dwBytes As LongPtr) As LongPtr

        Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
        Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
        Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long

        Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
                                                         ByVal lpString2 As Any) As LongPtr

        Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat _
                                                                As Long, ByVal hMem As LongPtr) As LongPtr
    #Else
        Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
        Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
        Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
                                                     ByVal dwBytes As Long) As Long

        Declare Function CloseClipboard Lib "User32" () As Long
        Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
        Declare Function EmptyClipboard Lib "User32" () As Long

        Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
                                                 ByVal lpString2 As Any) As Long

        Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
                                                        As Long, ByVal hMem As Long) As Long
    #End If
#End If
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Sub PasteFromClipboard()
    
    Application.ScreenUpdating = False
    ThisWorkbook.Sheets("Temp").Visible = True
    
    On Error GoTo ErrorHandler
    
    Sheets("Temp").Cells.ClearContents
    Sheets("Temp").Range("A1").PasteSpecial Paste:=xlPasteAll

    Application.CutCopyMode = False
    Sheets("Temp").Activate
    
    RenameColumnNames
    ThisWorkbook.Sheets("Temp").Visible = False
    Application.ScreenUpdating = True
    Sheets("Search").Activate
    MsgBox "Paste sucessful, Please click Analyse."


Exit Sub

ErrorHandler:
MsgBox "Nothing to paste!"
ThisWorkbook.Sheets("Temp").Visible = False
Sheets("Search").Activate
Application.ScreenUpdating = True
Exit Sub

End Sub

Sub Analyse() 'Excel VBA to move Columns based on criteria

    Application.ScreenUpdating = False
    ThisWorkbook.Sheets("Temp").Visible = True

Dim r As Range
Dim ar As Variant
Dim i As Integer
Dim rng As Range
Dim str As String

'Set shTemp = ThisWorkbook.Worksheets("Temp")
'Set shOutput = ThisWorkbook.Worksheets("Analyse")


'Set the Array Values
ar = Array("CRN", "Customer Name", "Circuit/Equip ID", "Extension", "SLA", "Service Type", "Status")
For i = 0 To UBound(ar) 'Loop through the Array
Sheets("Temp").Select
Set rng = [A1:AW1].Find(ar(i), lookat:=xlWhole)
On Error GoTo ErrorHandler2
str = str & rng.Address & ","
Next i 'Take the trailing comma from the string
str = Left(str, Len(str) - 1)
Set r = Range(str).EntireColumn
r.Copy Sheets("Analyse").[A1] 'Copy and Paste to new sheet in cell A1.


Sheets("Analyse").Activate
Columns("A:J").Select
Selection.EntireColumn.AutoFit
ActiveSheet.Cells(1, 1).Select
RefreshPivot
Sheets("Temp").Activate
Sheets("Temp").Cells.ClearContents
ThisWorkbook.Sheets("Temp").Visible = False
Application.CutCopyMode = False
Application.ScreenUpdating = True

Exit Sub

ErrorHandler2:
MsgBox "Nothing to Analyse!"
Sheets("Analyse").Activate
Columns("A:G").Select
Selection.Columns.ClearContents
'RefreshPivot           'Problem is that my measures are removed as the column headers are also cleared.
ThisWorkbook.Sheets("Temp").Visible = False
Sheets("Search").Activate
Application.ScreenUpdating = True
Exit Sub
End Sub
Sub RenameColumnNames()
    
    Application.ScreenUpdating = False
    ThisWorkbook.Sheets("Temp").Visible = True
    
    Dim TH As Range
    Dim ws As Worksheet
    Dim rngHeaders As Range
    
    Set TH = Sheets("Temp").Rows("1:1")
    
    On Error Resume Next
    'Column names in the "Temp" sheet can have two possible variants of the column names
    
    With Selection.Find(What:="Cct No/Eq ID", After:=ActiveCell, LookIn:= _
        xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext).Activate
    ActiveCell.Replace What:="Cct No/Eq ID", Replacement:="Circuit/Equip Id", _
        lookat:=xlWhole, SearchOrder:=xlByRows
    End With
    
    With Selection.Find(What:="Customer", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Activate
    ActiveCell.Replace What:="Customer", Replacement:="Customer Name", lookat _
        :=xlWhole, SearchOrder:=xlByRows
      Range("A1").Select
    End With
      
    
    ThisWorkbook.Sheets("Temp").Visible = False
    Application.ScreenUpdating = True

End Sub

Sub ClearSearchForm()
Dim tbx As OLEObject
For Each tbx In ActiveSheet.OLEObjects
If TypeName(tbx.Object) = "TextBox" Then
tbx.Object.Text = ""
End If
Next
End Sub