StackOverflowRows

Option Explicit

Sub CopyColumns()

    Dim CopyFromPath As String, FileName As String
    Dim CopyToWb As Workbook, wb As Workbook, CopyToWs As Worksheet
    Dim lastRow As Long, NextRow As Long, lcol As Long, c As Long, sv As Integer
    Dim ws As Worksheet
    Dim lngRow As Long: lngRow = 1
    Dim myCol As Long
    Dim myHeader As Range
    Application.ScreenUpdating = False
    CopyFromPath = "\\omeshare\HOME0027\3029\My Documents\StoredFolder\"
    Set CopyToWb = ActiveWorkbook
    Set CopyToWs = CopyToWb.Sheets("Master")
    FileName = Dir(CopyFromPath & "*.xlsx")
    Do While Len(FileName) > 0
        Set wb = Workbooks.Open(CopyFromPath & FileName)
        With wb.Sheets("Open Issue Actions")
            lngRow = lngRow + 1
            lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            For c = 1 To lcol
                wb.Sheets("Open Issue Actions").Activate
                If .Cells(1, c) = "Issue Type" Or .Cells(1, c) = "Issue DocID" Or .Cells(1, c) = "Country and/or Region" Or .Cells(1, c) = "Issue Title" Or _
                   .Cells(1, c) = "Issue Summary" Or .Cells(1, c) = "Issue Rating" Or _
                   .Cells(1, c) = "Issue Priority" Or .Cells(1, c) = "Issue Business Unit" Or _
                   .Cells(1, c) = "Action Due Date" Or .Cells(1, c) = "Issue Due Date" Or .Cells(1, c) = "Revised Due Date" Or _
                   .Cells(1, c) = "Responsible Business Executive" Or .Cells(1, c) = "Action Delivery Owner" Or _
                   .Cells(1, c) = "Current Update" Or .Cells(1, c) = "Issue / Action" Or _
                   .Cells(1, c) = "APAC / IHC / BICEP" Or .Cells(1, c) = "Horizontal / Vertical" Or _
                   .Cells(1, c) = "1LOD / 2LOD / 3LOD / Reg" Or .Cells(1, c) = "Owned / Impacted" Then
                    lastRow = .Cells(Rows.Count, c).End(xlUp).Row
                    If lastRow = 1 Then GoTo nxt

                    Range(Cells(2, c), Cells(lastRow, c)).Copy
                    CopyToWs.Activate
                    Set myHeader = CopyToWs.Rows(1).Find(What:=.Cells(1, c).Value, Lookat:=xlWhole)
                    With CopyToWs
                        If Not myHeader Is Nothing Then
                            myCol = myHeader.Column
                            NextRow = .Cells(Rows.Count, myCol).End(xlUp).Row + 1
                            .Cells(lngRow, myCol).PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                            Set myHeader = Nothing
                        End If
nxt:
                    End With
                End If
            Next c
            wb.Close saveChanges:=False
        End With
        FileName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub