vba Folderpicker pick file to paste filename and data in different workbook

Question

My folder1 consist of 12 files (file.Name = a.xlsx, b.xlsx, c.xlsx...,l.xlsx). Each file has 36columns. col(B1:AK1 = 1979, 1980, ..,2014).

In folder2, it consist of 36 files. (1979.xlsx, ...2014.xlsx).

I want each column in file in folder2 having respective data from folder1 and print the filename as well, so header in each file in folder2 will be col(B1:M1): (a,b,c,d..,l).

below is my code that I modify from various discussion. Its works fine but look quite towering, is there anything unnecessary or can be improved? Also, since I use filepicker rather than loop is it necessary to set MyFile = Dir at the end of code?

Sub OpenWorkbookUsingFileDialog() 
Dim fDialog As FileDialog
Dim FileName As String
Dim FileChosen As Integer
Dim FileSelected As Variant
Dim Files As String, MyFile As String
Dim wbk As Workbook
Dim cell As Range, Rng As Range
Dim x As String, ecol As Integer
Dim Folderpath, file As String, StationName As String
Dim lngStart, lngEnd As Long

Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

fDialog.Title = "Please Select an Excel File"
fDialog.InitialFileName = "G:\Sony Pendrive\Data Baru\WaterLevel\WL Refine\"
fDialog.InitialView = msoFileDialogViewSmallIcons
fDialog.Filters.Clear
fDialog.Filters.Add "Excel Macros Files", "*.xlsx"

FileChosen = fDialog.Show
FileSelected = fDialog.SelectedItems(1)
MyFile = Dir(FileSelected)

lngStart = InStr(fDialog.SelectedItems(1), "Sg")
lngEnd = InStr(fDialog.SelectedItems(1), "edit")
StationName = Mid(fDialog.SelectedItems(1), lngStart, lngEnd - lngStart - 1)

If FileChosen <> -1 Then
MsgBox "You have choosen nothing"
Else
MsgBox "you have select " & Station
End If
Set wbk = Workbooks.Open(FileName:=FileSelected)
Set Rng = wbk.Worksheets("sheet6").Range("B1:AK1")
 For Each cell In Rng
 x = cell.Value
 wbk.Worksheets("sheet6").Range(cell.Offset(1, 0), cell.Offset(1, 0).End(xlDown)).Copy

 Folderpath = "G:\Sony Pendrive\Data Baru\Tahun\PasteTahun\"
    Files = Folderpath & x & ".xlsx"
    Workbooks.Open (Files)
    ActiveWorkbook.Worksheets("sheet1").Select
    ecol = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
    ActiveSheet.Cells(1, ecol + 1).Value = StationName
        ActiveSheet.Cells(2, ecol + 1).Select
        ActiveSheet.Paste
        ActiveWorkbook.Close savechanges:=True

   Next cell
   MsgBox "done with " & wbk.Name
   wbk.Close savechanges:=True
   MyFile = Dir 'DIR gets the next file in the folder

   End Sub

Thank you in advance.